64bit フォルダ参照

Question

OSの環境によってVBA7か以外で使い分けをしようとしています。

64bit環境で以下のソースを実行すると★★★'の部分で型が違います'エラー

が発生してしまいます。

ご教授いただけないでしょうか。

Option Compare Database
Option Explicit

#If VBA7 Then    ' VBA7
 Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
 Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
 Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
 Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
 Public Const WM_USER = &H400
 Public Const BFFM_SETSELECTIONA = (WM_USER + 102)
 Public Const BFFM_INITIALIZED = 1
 
 Public Type BROWSEINFO
   hOwner As LongPtr
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As LongPtr
   lParam As LongPtr
   iImage As Long
 End Type
 
#Else    ' Downlevel when using previous version of VBA7
 Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA"  (ByVal pidl As Long, ByVal pszPath As String) As Long
 Private Declare Function SHBrowseForFolder Lib "shell32.dll"  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
 Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"  (ByVal hWnd As Long, ByVal wMsg As Long,  ByVal wParam As Long, lParam As Any) As Long
 
 Public Const WM_USER = &H400
 Public Const BFFM_SETSELECTIONA = (WM_USER + 102)
 Public Const BFFM_INITIALIZED = 1
 
 Public Type BROWSEINFO
   hOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As Long
   lParam As Long
   iImage As Long
 End Type
 
#End If

Sub GetFolderName()
    Dim buf As String
    buf = GetDirectory("フォルダを選択してください", "E:\Develop")
    If buf = "" Then
        Exit Sub
    Else
        MsgBox buf
    End If
End Sub

Function GetDirectory(Optional Msg, Optional UserPath) As String
    Dim bInfo As BROWSEINFO, pPath As String
    Dim R As Long, X As Long, pos As Integer
    With bInfo
        .pidlRoot = &H0
        If IsMissing(Msg) Then
            .lpszTitle = "フォルダの選択..."
        Else
            .lpszTitle = Msg
        End If
        .ulFlags = &H40
        .lpfn = FARPROC(AddressOf BrowseCallbackProc)
        If IsMissing(UserPath) Then
            .lParam = CurDir & Chr(0)   ''またはvbNullChar
        Else
            .lParam = UserPath & Chr(0) ★★★'型が違います'エラー
        End If
    End With
    X = SHBrowseForFolder(bInfo)
    pPath = Space$(512)
    R = SHGetPathFromIDList(ByVal X, ByVal pPath)
    CoTaskMemFree X
    If R Then
        pos = InStr(pPath, Chr(0))
        GetDirectory = Left(pPath, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function

#If VBA7 Then    ' VBA7

Public Function BrowseCallbackProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal lParam As LongPtr, ByVal lpData As Long) As Long  ''コールバック関数
    If uMsg = BFFM_INITIALIZED Then
          SendMessage hWnd, BFFM_SETSELECTIONA, 1, ByVal lpData
    End If
End Function

Public Function FARPROC(pfn As LongPtr) As LongPtr    ''AddressOf演算子の戻り値を戻す関数
    FARPROC = pfn
End Function

#Else    ' Downlevel when using previous version of VBA7

Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long  ''コールバック関数
    If uMsg = BFFM_INITIALIZED Then
          SendMessage hWnd, BFFM_SETSELECTIONA, 1, ByVal lpData
    End If
End Function

Public Function FARPROC(pfn As Long) As Long    ''AddressOf演算子の戻り値を戻す関数
    FARPROC = pfn
End Function

#End If