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

ms项目VBA中的GetOpenFileName函数

1 个答案: