vba - ms项目VBA中的GetOpenFileName函数

Question

我正在尝试在 vba for ms 项目中使用 GetOpenFileName 函数。它是否仅在excel中可用？没有选项可以在 ms 项目中使用它？谢谢。

Answer 1

我遇到了同样的问题，显然“GetOpenFineName”函数在 Excel 中有效，但在 MS Projects 中不受支持。你必须自己写。

为了使它更容易，您可以在下面找到您必须在 MS 项目中的程序顶部复制过去的代码。然后，您可以在自己在程序中编写的代码中使用 GetOpenFileName。

祝你好运。

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_EXPLORER = &H80000
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_READONLY = &H1
Private Const OFN_SHOWHELP = &H10

Private Declare Function GetOpenFileNameA Lib "comdlg32.dll" _
    (OFN As OPENFILENAME) As Boolean

Private Declare Function GetSaveFileNameA Lib "comdlg32.dll" _
    (OFN As OPENFILENAME) As Boolean

Private Const ALLFILES = "All Files"

Function MakeFilterString(ParamArray varFilt() As Variant) As String
    ' Creates a filter string.
    ' Returns "" if there are no arguments.
    ' Expects an even number of argumenten (filter name, extension).
    ' Adds *.* if the number of arguments is odd.

    Dim strFilter As String
    Dim intRes As Integer
    Dim intNum As Integer

    intNum = UBound(varFilt)
    If intNum <> -1 Then
        For intRes = 0 To intNum
            strFilter = strFilter & varFilt(intRes) & vbNullChar
        Next
        If intNum Mod 2 = 0 Then
            strFilter = strFilter & "*.*" & vbNullChar
        End If

        strFilter = strFilter & vbNullChar
    End If

    MakeFilterString = strFilter
End Function

Private Sub InitOFN(OFN As OPENFILENAME)
    With OFN
        ' Initialize fields
        .hwndOwner = 0
        .hInstance = 0
        .lpstrCustomFilter = vbNullString
        .nMaxCustFilter = 0
        .lpfnHook = 0
        .lpTemplateName = 0
        .lCustData = 0
        .nMaxFile = 511
        .lpstrFileTitle = String(512, 0)
        .nMaxFileTitle = 511
        .lStructSize = Len(OFN)
        If .lpstrFilter = "" Then
            .lpstrFilter = MakeFilterString(ALLFILES)
        End If
        .lpstrFile = .lpstrFile & String(512 - Len(.lpstrFile), 0)
    End With
End Sub

Private Sub ProcessOFN(OFN As OPENFILENAME)
    With OFN
        .lpstrFile = Left$(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1)
    End With
End Sub

Private Function OpenDialog(OFN As OPENFILENAME) As Boolean
    ' Display the Open dialog.
    Dim intRes As Integer
    InitOFN OFN
    intRes = GetOpenFileNameA(OFN)
    If intRes Then
        ProcessOFN OFN
    End If
    OpenDialog = intRes
End Function

Private Function SaveDialog(OFN As OPENFILENAME) As Boolean
    ' Display the Save As dialog.
    Dim intRes As Integer
    InitOFN OFN
    intRes = GetSaveFileNameA(OFN)
    If intRes Then
        ProcessOFN OFN
    End If
    SaveDialog = intRes
End Function

Private Function GetOpenFileName(Optional FileFilter As String, Optional FilterIndex As Long, Optional Title As String = "Select a File") As String
    Dim OFN As OPENFILENAME
    With OFN
        If FileFilter <> "" Then
            .lpstrFilter = Replace(FileFilter, ",", vbNullChar) & vbNullChar
        End If
        .nFilterIndex = FilterIndex
        .lpstrTitle = Title
    End With
    If OpenDialog(OFN) Then
        GetOpenFileName = OFN.lpstrFile
    End If
End Function

Private Function GetSaveAsFileName(InitialFileName As String, Optional FileFilter As String, Optional FilterIndex As Long, Optional Title As String = "Select a File") As String
    Dim OFN As OPENFILENAME
    With OFN
        .lpstrFile = InitialFileName
        If FileFilter <> "" Then
            .lpstrFilter = Replace(FileFilter, ",", vbNullChar) & vbNullChar
        End If
        .nFilterIndex = FilterIndex
        .lpstrTitle = Title
    End With
    If SaveDialog(OFN) Then
        GetSaveAsFileName = OFN.lpstrFile
    End If
End Function