在64bitAccess中，原来32bit的Declare Function GetOpenFileName Lib "comdlg32.dll" 报错问题

在64bitAccess中，原来32bit的Declare Function GetOpenFileName Lib “comdlg32.dll” 报错问题，可以通过下面方法解决：

第一步：在Delcare后面增加PtrSafe关键字
比如： Private Declare Function GetOpenFileName Lib “comdlg32.dll” Alias “GetOpenFileNameA” (pOpenfilename As OPENFILENAME) As Long

改为

Private Declare PtrSafe Function GetOpenFileName Lib “comdlg32.dll” Alias “GetOpenFileNameA” (pOpenfilename As OPENFILENAME) As Long

第二步:改Long类型为LongPtr
将OPENFILENAME的hwndOwner、hInstance、lpfnHook三个类型由long改为LongPtr

第三步：将lStructSize中的Len()改为LenB()
如：Len(fFileName)改为LenB(fFileName)

这样就解决了32bit系统可以运行，而64bit中无法运行的问题。

其它实例代码如下：

Option Compare Database
Option Explicit

Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Declare PtrSafe Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Type OPENFILENAME
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        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 LongPtr
        lpTemplateName As String
End Type

Const OFN_READONLY = &H1
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_SHOWHELP = &H10
Const OFN_ENABLEHOOK = &H20
Const OFN_ENABLETEMPLATE = &H40
Const OFN_ENABLETEMPLATEHANDLE = &H80
Const OFN_NOVALIDATE = &H100
Const OFN_ALLOWMULTISELECT = &H200
Const OFN_EXTENSIONDIFFERENT = &H400
Const OFN_PATHMUSTEXIST = &H800
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_CREATEPROMPT = &H2000
Const OFN_SHAREAWARE = &H4000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOTESTFILECREATE = &H10000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOLONGNAMES = &H40000
Const OFN_EXPLORER = &H80000
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_LONGNAMES = &H200000

Const OFN_SHAREFALLTHROUGH = 2
Const OFN_SHARENOWARN = 1
Const OFN_SHAREWARN = 0

Const MAX_PATH = 260

'strFilter = 僼傿儖僞暥帤
'strInitialDir = 弶婜僼傽僀儖
'strTitle = 僼傽僀儖僟僀傾儘僌偺僞僀僩儖
'strDefExt = 奼挘巕偑徣棯偝傟偨帪偺奼挘巕
'blOpen = 僼傽僀儖傪奐偔僟僀傾儘僌側傜 True
'         僼傽僀儖偺曐懚僟僀傾儘僌側傜 False
Function spFileDlg(strFilter As String, strInitialDir As String, strTitle As String, strDefExt As String, blOpen As Boolean, FN As String)
    Dim fFileName As OPENFILENAME
    Dim strBuff As String
    Dim accWnd As Long

    Dim lngRet As Long

    accWnd = FindWindow("OMAIN", vbNullString)

    strBuff = FN & String$(MAX_PATH - LenB(FN), 0)

    With fFileName
        .lStructSize = LenB(fFileName)
        .hwndOwner = accWnd
        .hInstance = 0
        .lpstrFilter = strFilter
        .nMaxCustFilter = 0&
        .nFilterIndex = 0
        .lpstrFile = strBuff
        .nMaxFile = MAX_PATH
        .lpstrFileTitle = String$(MAX_PATH, 0)
        .nMaxFileTitle = MAX_PATH + 1
        .lpstrInitialDir = strInitialDir
        .lpstrTitle = strTitle
        .flags = OFN_HIDEREADONLY
        .lpstrDefExt = strDefExt
    End With
    
    If blOpen = True Then
        lngRet = GetOpenFileName(fFileName)
        
    Else
        lngRet = GetSaveFileName(fFileName)
    End If

    If lngRet <> 0 Then
        spFileDlg = fFileName.lpstrFile
    Else
        spFileDlg = "CANCEL"
    End If
End Function

'僼傽僀儖?
'FN:棉太倌抬操?
'TL:擂脖鄹蘩材
'TP:抬操啦踢
'OP:False:弌椡(EXPORT)
'   True :擖椡(IMPORT)
Function Get_FileName(FN As Variant, TL As Variant, TP As Variant, OP As Boolean, Optional DFLG As Boolean = True)
Dim ret As Variant
Dim S_DIR As String
Dim S_FN As String
Dim l As Integer
Dim FILENAME As String
Dim S_TL As String
Dim S_TP As String

Get_FileName = "CANCEL"
S_TL = TL
S_TP = TP

'弌?
If (IsNull(FN) Or (Len(Trim(FN)) = 0)) Then
    S_DIR = ""
    S_FN = ""
Else
    l = 1
    ret = 1
    Do While (ret > 0)
        ret = InStr(l, FN, "\")
        If (IsNull(ret)) Then
            S_DIR = ""
            S_FN = ""
            ret = 0
        End If
        If (ret = 0) Then
            S_DIR = MID(FN, 1, l - 1)
            S_FN = MID(FN, l)
        End If
        l = ret + 1
    Loop
End If

Select Case TP
Case "TXT"
    FILENAME = spFileDlg( _
        "TextFile (*.txt)" & vbNullChar & "*.txt" & vbNullChar & "All File (*.*)" & vbNullChar & "*.*", _
        S_DIR, _
        S_TL, _
        S_TP, _
        OP, _
        S_FN)
Case "CSV"
    FILENAME = spFileDlg( _
        "TextFile (*.csv)" & vbNullChar & "*.csv" & vbNullChar & "All File (*.*)" & vbNullChar & "*.*", _
        S_DIR, _
        S_TL, _
        S_TP, _
        OP, _
        S_FN)
Case "XLS"
    FILENAME = spFileDlg( _
        "ExcelFile (*.xls)" & vbNullChar & "*.xls" & vbNullChar & "TEXT抬操 (*.csv)" & vbNullChar & "*.csv" & vbNullChar & "All File (*.*)" & vbNullChar & "*.*", _
        S_DIR, _
        S_TL, _
        S_TP, _
        OP, _
        S_FN)
Case "MDB"
    FILENAME = spFileDlg( _
        "AccessFile (*.mdb)" & vbNullChar & "*.mdb" & vbNullChar & "All File (*.*)" & vbNullChar & "*.*", _
        S_DIR, _
        S_TL, _
        S_TP, _
        OP, _
        S_FN)
Case Else
    FILENAME = spFileDlg( _
        "All File (*.*)" & vbNullChar & "*.*", _
        S_DIR, _
        S_TL, _
        S_TP, _
        OP, _
        S_FN)
End Select
If FILENAME = "CANCEL" Then
    Exit Function
End If
    
'僼傽僀儖柤挷?
ret = InStr(1, FILENAME, Chr(0))
If (IsNull(ret)) Then
    Exit Function
Else
    If (ret > 0) Then
        FILENAME = MID(FILENAME, 1, ret - 1)
    End If
End If

If (OP = False And DFLG) Then
    If (Len(Dir(FILENAME)) > 0) Then
        ret = MsgBox("OverWrite. OK?", vbYesNo, "OverWrite")
        If (ret <> vbYes) Then
            Exit Function
        Else
            Err = 0
            On Error Resume Next
            Kill FILENAME
            On Error GoTo 0
            If (Err <> 0) Then
                ret = MsgBox("OverWrite Error. File Opened? ", , "OverWriteError")
                Exit Function
            End If
        End If
    End If
End If

Get_FileName = FILENAME

End Function