montrof
12-20-2018, 12:10 PM
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
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