Стандартный диалог выбора директории

Private Type BrowseInfo
     hWnd As Long
     ITEMIDLIST As Long
     DislayName As Long
     Title As Long
     Flags As Long
     CallbackFN As Long
     Param As Long
     Image As Long
End Type
Private Const FOLDERSONLY As Long = 1
Private Const MAX_PATH As Long = 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 BrowseFolders(Parent_hWnd As Long, Prompt As String) As String
    Dim Position As Integer
    Dim ITEMIDLIST As Long
    Dim Response As Long
    Dim Path As String
    Dim BrowseInfo As BrowseInfo
    With BrowseInfo
        .hWnd = Parent_hWnd
        .Title = lstrcat(Prompt, '')
        .Flags = FOLDERSONLY
    End With
    ITEMIDLIST = SHBrowseForFolder(BrowseInfo)
    If ITEMIDLIST Then
        Path = String$(MAX_PATH, 0)
        Response = SHGetPathFromIDList(ITEMIDLIST, Path)
        CoTaskMemFree ITEMIDLIST
        Position = InStr(Path, vbNullChar)
        If Position Then
            Path = Left$(Path, Position - 1)
        End If
    End If
    BrowseFolders = Path
End Function