Option Explicit

Private Type BrowseInfo
    hWndOwner      As Long
    pIDLRoot       As Long
    pszDisplayName As Long
    lpszTitle      As Long
    ulFlags        As Long
    lpfnCallback   As Long
    lParam         As Long
    iImage         As Long
End Type

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal _
   lpString1 As String, ByVal lpString2 As String) As Long
   
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As _
   BrowseInfo) As Long
   
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal _
   pidList As Long, ByVal lpBuffer As String) As Long

Public Function BrowseForFolder(hWndOwner As Long, sPrompt As _
   String) As String

    Dim nNull As Integer
    Dim lpIDList As Long
    Dim nResult As Long
    Dim sPath As String
    Dim bi As BrowseInfo

    bi.hWndOwner = hWndOwner
    bi.lpszTitle = lstrcat(sPrompt, "")
    bi.ulFlags = BIF_RETURNONLYFSDIRS

    lpIDList = SHBrowseForFolder(bi)
    
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        nResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        nNull = InStr(sPath, vbNullChar)
        If nNull Then
            sPath = Left$(sPath, nNull - 1)
        End If
    End If

    BrowseForFolder = sPath

End Function

    Debug.Print BrowseForFolder(Me.hWnd, "Please select a folder:")