Robert Crandal used his keyboard to write :
I put this code in a Sub and I got an error message that
said something like "Exit not allowed in Sub". Should
I replace that "Exit Function" code with something else?
What is that code for anyways?
Thanks!
Hi Robert,
That code is a snippet from a function I reuse in many projects, which
returns the full path to the user's selected folder. (Thus 'End
Function') There's no value to putting this code in a sub because you'd
have to repeat for every procedure you want to get a folder path for.
the function is also configured to use the folder picker APIs for
earlier versions that don't support FileDialog.
Here's my function and its required declarations. You can just copy
this into a standard module that you can drop into any project!
(Watch for word wrapping)
<API Declarations>
'32-bit API declarations required for folder selection
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As
Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
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
Const mszPickFolder As String = "Select the folder where the files are
located."
<Functions>
Function szPickFolder() As String
' Allows the user to select a folder location.
Const sSource As String = "szPickFolder()"
Dim sPath As String
If Application.Version > 9 Then '//use the newer dialog
With Application.FileDialog(4) '//msoFileDialogFolderPicker
If .Show = False Then Exit Function 'User cancelled
sPath = .SelectedItems(1)
End With
Else '//use the API dialog
sPath = GetDirectory(mszPickFolder)
End If
If sPath = "" Then Exit Function 'User cancelled
szPickFolder = sPath
End Function '//szPickFolder()
Function GetDirectory(Optional msg As String) As String
' Opens the dialog for picking the folder
Dim bInfo As BROWSEINFO, sPath As String
Dim r As Long, x As Long
If msg = "" Then msg = "Select a folder."
With bInfo
.pidlRoot = 0& '//root folder = Desktop
.lpszTitle = msg '//title the dialog
.ulFlags = &H1 '//type of directory to return
End With
x = SHBrowseForFolder(bInfo) '//display the dialog
'Parse the result
sPath = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal sPath)
If r Then
GetDirectory = Left(sPath, InStr(sPath, Chr$(0)) - 1)
Else
GetDirectory = ""
End If
End Function '//GetDirectory
<To use this code from any procedure>
Dim sPathToFolder As String
sPathToFolder = szPickFolder
HTH
