64 bit excel question

[montrof]

I know that this has been answered but I have tried to model my code after the examples and keep failing


Public SqlScript As String
Public cn As New ADODB.Connection


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 udtBROWSE_INFO) As Long
Private Type udtBROWSE_INFO
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


And then I call it


Private Function strBrowse_For_Folder(Optional strTitle As String = "") As String


Dim udtBROWSE_INFO As udtBROWSE_INFO
Dim lngResult As Long
Dim strPath As String
Dim strReturn As String


On Error GoTo Err_strBrowse_For_Folder


strReturn = ""


udtBROWSE_INFO.pidlRoot = 0& ' Root folder (Desktop)


If IsMissing(strTitle) Then
udtBROWSE_INFO.lpszTitle = "Select a folder"
Else
udtBROWSE_INFO.lpszTitle = strTitle
End If


udtBROWSE_INFO.ulFlags = &H1 ' Type of directory to return


lngResult = SHBrowseForFolder(udtBROWSE_INFO)


strPath = Space$(512)
lngResult = SHGetPathFromIDList(ByVal lngResult, ByVal strPath)


If lngResult Then
strReturn = Left$(strPath, InStr(strPath, Chr$(0)) - 1)
End If


Exit_strBrowse_For_Folder:


On Error Resume Next


strBrowse_For_Folder = strReturn


Exit Function


Err_strBrowse_For_Folder:


On Error Resume Next


strReturn = ""


Resume Exit_strBrowse_For_Folder


End Function


I cannot get it to work

Sorry to be so lame but any help would be greatly apperciated

Thanks,
Montrof

[Aflatoon]

Untested, but I think this should work:

Option Explicit

Public SqlScript As String
Public cn As New ADODB.Connection


#If VBA7 Then
Private Declare PtrSafe Function SHGetPathFromIDList _
Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As LongPtr, _
ByVal pszPath As String) As Long


Private Declare PtrSafe Function SHBrowseForFolder _
Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBROWSEINFO As udtBROWSE_INFO) As LongPtr
Private Type udtBROWSE_INFO
hOwner As LongPtr
pidlRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As LongPtr
lParam As LongPtr
iImage As Long
End Type

#Else
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 udtBROWSE_INFO) As Long
Private Type udtBROWSE_INFO
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
Private Function strBrowse_For_Folder(Optional strTitle As String = "") As String




Dim udtBROWSE_INFO As udtBROWSE_INFO
Dim strPath As String
Dim strReturn As String
#If VBA7 Then
Dim lngResult As LongPtr
#Else
Dim lngResult As Long
#End If


On Error GoTo Err_strBrowse_For_Folder




strReturn = ""




udtBROWSE_INFO.pidlRoot = 0& ' Root folder (Desktop)




If IsMissing(strTitle) Then
udtBROWSE_INFO.lpszTitle = "Select a folder"
Else
udtBROWSE_INFO.lpszTitle = strTitle
End If




udtBROWSE_INFO.ulFlags = &H1 ' Type of directory to return




lngResult = SHBrowseForFolder(udtBROWSE_INFO)




strPath = Space$(512)
lngResult = SHGetPathFromIDList(ByVal lngResult, ByVal strPath)




If lngResult Then
strReturn = Left$(strPath, InStr(strPath, Chr$(0)) - 1)
End If




Exit_strBrowse_For_Folder:




On Error Resume Next




strBrowse_For_Folder = strReturn




Exit Function




Err_strBrowse_For_Folder:




On Error Resume Next




strReturn = ""




Resume Exit_strBrowse_For_Folder




End Function

[montrof]

Thank you this works perfect.