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 Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long

Const BIF_RETURNONLYFSDIRS = &H1

Private Sub Command1_Click()
Dim myBrowseInfo As BROWSEINFO
Dim execNumderDir As Boolean
Dim NumderDir As Long
Dim pos As Integer
Dim myPath_512 As String
Dim myPath as String

With myBrowseInfo
.hOwner = Me.hWnd
.pidlRoot = 0&
.lpszTitle = "Select directory"
.ulFlags = BIF_RETURNONLYFSDIRS
End With

NumderDir& = SHBrowseForFolder(myBrowseInfo)
myPath_512$ = Space$(512)
execNumderDir = SHGetPathFromIDList(ByVal NumderDir&, ByVal myPath_512$)

If execNumderDir Then
pos = InStr(myPath_512$, Chr$(0))
myPath = Left(myPath_512$, pos - 1)
Else:
myPath = ""
End If
Text1.Text = myPath
End Sub