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
    
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" (ByVal hMem As Long)

Private Const MAX_PATH = 260
'Directories only
Private Const BIF_RETURNONLYFSDIRS = &H1&
'Windows 2000 (Shell32.dll 5.0) extended dialog
Private Const BIF_NEWDIALOGSTYLE = &H40
' show edit box
Private Const BIF_EDITBOX = &H10&

Public Function BrowseForFolder() As String
  Dim tBI         As BROWSEINFO
  Dim lngPIDL     As Long
  Dim strPath     As String
  
  With tBI
    .lpszTitle = ""
    .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE Or BIF_EDITBOX
  End With
  
  lngPIDL = SHBrowseForFolder(tBI)
  
  If (lngPIDL <> 0) Then
    ' get path from ID list
    strPath = Space$(MAX_PATH)
    SHGetPathFromIDList lngPIDL, strPath
    
    strPath = Left$(strPath, InStr(strPath, Chr$(0)) - 1)
    
    ' release list
    CoTaskMemFree lngPIDL
  End If
  
  BrowseForFolder = strPath
End Function