Access利用Windows API打开文件对话框

Option Explicit
'*------------------------------------------------------------------------
'* Purpose: 声名打开文件API函数
'*------------------------------------------------------------------------
Private Type OpenFileName
    lngStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    intMaxCustFilter As Long
    intFilterIndex As Long
    strFile As String
    intMaxFile As Long
    strFileTitle As String
    intMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    lngFlags As Long
    intFileOffset As Integer
    intFileExtension As Integer
    'strDefaultExtension As String
    strDefExt As String
    lngCustData As Long
    lngfnHook As Long
    strTemplateName As String
End Type

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (ofn As OpenFileName) As Boolean

Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (ofn As OpenFileName) As Boolean

Public Function dlgGetFile(Optional ByRef lngFlags As Long, _
                            Optional strInitDir As String, _
                            Optional strFilter As String, _
                            Optional strDialogTitle As String, _
                            Optional fOpenFile As Boolean, _
                            Optional strFileName = "", _
                            Optional intFilterIndex As Integer, _
                            Optional strDefaultExt As String = "", _
                            Optional hWnd As Long) As Variant
'------------------------------------------------------------------------
'*lngFlag: 返回标志,如果选择取消按钮,则值为0,成功为1024
'*strInitDir: 初始目录
'*strFilter: 过滤器
'* 过滤器格式:"说明"&vbNullChar&"过滤器"[&vbNullChar&"其它说明"&vbNullChar&"其它过滤"
'* 如"Excel文件&Chr(0)&"*.xls"&chr(0)&"所有文件"&chr(0)&"*.*"
'*strDialogTitle: 对话框标题
'*fOpenFile   = True: Open, GetOpenFileName(ofn)          打开文件对话框
'*            = False: Save, GetSaveFileName(ofn)         保存文件对话框
'------------------------------------------------------------------------
    Dim ofn As OpenFileName
    Dim strFileTitle As String
    Dim fResult As Boolean
    If strInitDir = "" Then
        strInitDir = CurDir
    End If
    If hWnd = -1 Then
        hWnd = Application.hWndAccessApp
    End If
    strFileName = strFileName & String(255 - Len(strFileName), 0)
    strFileTitle = String(255, 0)
    With ofn
        .strInitialDir = strInitDir
        .lngStructSize = Len(ofn)
        .hwndOwner = hWnd
        .strFilter = strFilter
        .intFilterIndex = intFilterIndex
        .strFile = strFileName
        .intMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .intMaxFileTitle = Len(strFileTitle)
        .strTitle = strDialogTitle              '对话框标题
        .lngFlags = lngFlags
        .strDefExt = strDefaultExt
        .hInstance = 0
        .strCustomFilter = String(255, 0)
        .intMaxCustFilter = 255
        .lngfnHook = 0
    End With
    If fOpenFile Then
        fResult = GetOpenFileName(ofn)
    Else
        fResult = GetSaveFileName(ofn)
    End If
    If fResult Then
        lngFlags = ofn.lngFlags
        dlgGetFile = TrimNull(ofn.strFile)
    Else
        dlgGetFile = TrimNull(ofn.strFile)
    End If
End Function
Function TrimNull(ByVal strValue As String) As String
    Dim intPos As Integer
    intPos = InStr(strValue, vbNullChar)
    Select Case intPos
    Case 0
          TrimNull = strValue
    Case 1
          TrimNull = ""
    Case Is > 1
          TrimNull = Left＄(strValue, intPos - 1)
    End Select
End Function
'-----------------------------------------------------------------------
'* Purpose: 打开获取目录窗口
'* Mention: 只能单选
'-----------------------------------------------------------------------
Public Function dlgGetFolder(Optional dFolder As String, Optional szTitle As String) As String
    Dim lpIDList As Long
    Dim sBuffer As String
    Dim tBrowseInfo As BROWSEINFO
    
    defaultFolder = dFolder & vbNullChar
    
    With tBrowseInfo
        .lpszTitle = szTitle
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_STATUSTEXT
        .lpfn = GetAddressofFunction(AddressOf BrowseCallbackProc)
    End With
    
    lpIDList = SHBrowseForFolder(tBrowseInfo)
    
    If (lpIDList) Then
        sBuffer = Space(MAX_PATH)
        SHGetPathFromIDList lpIDList, sBuffer
        sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
        dlgGetFolder = sBuffer
    End If
    
    If Not Right(dlgGetFolder, 1) = "/" Then
        dlgGetFolder = dlgGetFolder & "/"
    End If
End Function