BrowseFolders - Show the BrowseForFolders standard dialog

Option Explicit

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal _
    hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private 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

Private Type SHITEMID
    cb As Long
    abID As Byte
End Type

Private Type ITEMIDLIST
    mkid As SHITEMID
End Type

Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const BIF_BROWSEFORPRINTER = &H2000


' Show the standard "BrowseForFolder" dialog to select a folder.
' hWnd is the handle of the parent form
' DialogText is an optional message to show on the dialog
'
' Example: MsgBox "You selected " & BrowseFolders(Me.hwnd,
'  "Select your favourite folder")

Function BrowseFolders(ByVal hwnd As Long, Optional ByVal DialogText As String = _
    "@@@") As String
    Dim BI As BROWSEINFO
    Dim lID As Long
    Dim szPath As String
    
    BI.hOwner = hwnd
    ' if specified, set the dialog's descriptive text
    If DialogText <> "@@@" Then BI.lpszTitle = DialogText
    ' return physical folders only
    BI.ulFlags = BIF_RETURNONLYFSDIRS
    szPath = Space$(1024)
    ' show the dialog
    lID = SHBrowseForFolder(BI)
    
    ' get the path from the returned ID, otherwise return a null string
    If SHGetPathFromIDList(ByVal lID, ByVal szPath) Then
        BrowseFolders = Left$(szPath, InStr(szPath, vbNullChar) - 1)
    End If
End Function