Type BROWSEINFO ' для выбора каталога
hwndOwner 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

' константы для диалога выбора пути
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000

' ф-ция получения строки пути
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

' ф-ция диалога выбора пути
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
' ф-ция выбора каталога
Public Function BrowseFolder(Title, Value As String) As String
Dim bInf As BROWSEINFO
Dim RetVal As Long
Dim PathID As Long
Dim RetPath As String
Dim Offset As Integer
'bInf.hwndOwner = Me.hWnd
bInf.pidlRoot = 0&
bInf.lpszTitle = Title
bInf.ulFlags = BIF_RETURNONLYFSDIRS
PathID = SHBrowseForFolder(bInf)
RetPath = Space$(512)
RetVal = SHGetPathFromIDList(ByVal PathID, ByVal RetPath)
If RetVal Then
Offset = InStr(RetPath, Chr$(0))
BrowseFolder = Left$(RetPath, Offset - 1)
Else
BrowseFolder = Value
End If
End Function