64bitAccessで、オリジナルの32bit Declare Function GetOpenFileName Lib "comdlg32.dll" がエラー問題を報告する。

64bitAccessでは、本来の32bit Declare Function GetOpenFileName Lib "comdlg32.dll" のエラー問題は、以下の方法で解決することが可能です。

ステップ1：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

ステップ2：Long型をLongPtrに変更する



OPENFILENAMEのhwndOwner, hInstance, lpfnHookの型をlongからLongPtrに変更。

ステップ3：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 = &H40,000
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 = armed armed security

'strTitle = threaded threaded threaded threaded threaded threaded threaded threaded threaded threaded threaded threaded threaded threaded thread
'strDefExt = digging into the business of the business of the clone and unloading
'blOpen = 巍巍巍巍巍巍毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅毅
' 鈥淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒淒
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 =
        .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: get the name of the state
'TP:TP:TP:TP
'OP:False:на(EXPORT)
' True :program(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

'The consensus?
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 lift operation (*.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
    
Do you want to do more than one thing?
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