GetOpenFileName函数在ms项目VBA



我试图使用GetOpenFileName函数,在vba ms项目。只有excel版本吗?没有在ms项目中使用它的选项?谢谢。

我有同样的问题显然"GetOpenFineName"函数在Excel中工作,但在MS项目中不受支持。你得自己写。

为了使它更容易,下面你可以找到你必须在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

最新更新