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


Dim strPath As String
    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
    Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
    Const BIF_RETURNONLYFSDIRS =  1 , MAX_PATH =  260 
    Dim intNull As Integer, lngIdList As Long
    Dim udtBI As BrowseInfo

With udtBI
        .hwndOwner = hwndOwner
        .lpszTitle = sPrompt
        .ulFlags = BIF_RETURNONLYFSDIRS
End With
   lngIdList = SHBrowseForFolder(udtBI)
    If lngIdList Then
       strPath = String$(MAX_PATH,  0 )
       SHGetPathFromIDList lngIdList, strPath
       CoTaskMemFree lngIdList
       intNull = InStr(strPath, vbNullChar)
        If intNull Then strPath = Left$(strPath, intNull -  1 )
    End If
   BrowseForFolder = strPath
End Function
'--------------------------------------------------------------------------------


Private Sub Command1_Click()
   BrowseForFolder Me.hWnd, "Hi, Select ... "
   Debug.Print strPath
End Sub