Диалог для выбора папки в VBA

'<<<<<<<<<DEKLARACIJA>>>>>>>>>>>>>>>>
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
'
'
' dlia vybora kataloga,
Private Const BIF_RETURNONLYFSDIRS = &H1
' dlia zapuska komandy FIND
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNFSANCESTORS = &H8
' prosmotr kompiuterov
Private Const BIF_BROWSEFORCOMPUTER = &H1000
' prosmotr printerov
Private Const BIF_BROWSEFORPRINTER = &H2000
' prosmotr vsego
Private Const BIF_BROWSEINCLUDEFILES = &H4000
'
Private Const MAX_PATH = 260
 
'   Deklaracija API
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
 
'((((((((((((((((((((((((STARTUEM))))))))))))))))))))))))))))))))))
Public Sub Poisk_kataloga()
  Dim MyStr As String
  Dim Hwnd As Long
  
  MyStr = BrowseForFolder(Hwnd, "Zagolovok!")
 
End Sub
 
Public Function BrowseForFolder(hWndOwner As Long, _
  sPrompt As String) As String
  '==================================================
  ' Otkryvaem sistemnoe dialogovoe okno dlia prosmotra katalogov
  '==================================================
  Dim iNull As Integer
  Dim lpIDList As Long
  Dim lResult As Long
  Dim sPath As String
  Dim udtBI As BrowseInfo
  '
  udtBI.lpszTitle = lstrcat(sPrompt, "")
  udtBI.ulFlags = BIF_RETURNONLYFSDIRS
    
  lpIDList = SHBrowseForFolder(udtBI)
  If lpIDList Then
    sPath = String$(MAX_PATH, 0)
    lResult = SHGetPathFromIDList(lpIDList, sPath)
    Call CoTaskMemFree(lpIDList)
    iNull = InStr(sPath, vbNullChar)
    If iNull Then sPath = Left$(sPath, iNull - 1)
  End If
  BrowseForFolder = sPath
End Function

Private Sub btnChooseFolder_Click()
 Dim fd As FileDialog
 Dim vrtSelectedItem As Variant
 
 Set fd = Application.FileDialog(msoFileDialogFolderPicker)
 With fd
    .ButtonName = "Выбрать"
        'Нажата кнопка "Выбрать"
    If .Show = -1 Then
        For Each vrtSelectedItem In .SelectedItems
            'запись пути
            Path = vrtSelectedItem
        Next vrtSelectedItem
    'Нажата кнопка Cancel.
    Else
        Exit Sub
    End If
 End With
 
 Set fd = Nothing
End Sub