Attribute VB_Name = "BrowseForFolders"
'From VBnet http://www.mvps.org/vbnet/code/shell/browsefolders.htm
Option Explicit
'API declares
Public 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
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const MAX_PATH = 256
Public pidl As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Public Function BrowseForFolder(FormTitle As String, ApplicationTitle As Form)
'Call the fuction with FormTitle being the string you want the window to have as title,
'and ApplicationTitle as Me, or your main form's name.
Dim bi As BROWSEINFO
Dim pidl As Long
Dim path As String
Dim pos As Integer
'Fill the BROWSEINFO structure with the needed data 'the calling app
 
 bi.hOwner = ApplicationTitle.hwnd 'Pointer to the item identifier list specifying
'the location of the "root" folder to browse from.

'If NULL, the desktop folder is used.
bi.pidlRoot = 0&

'message to be displayed in the Browse dialog
 bi.lpszTitle = FormTitle
 
'the type of folder to return.
bi.ulFlags = BIF_RETURNONLYFSDIRS

'show the browse for folders dialog
pidl = SHBrowseForFolder(bi)

'the dialog has closed, so parse & display the
'user's returned folder selection contained in pidl
path = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
pos = InStr(path, Chr$(0))
BrowseForFolder = Left(path, pos - 1)
End If
Call CoTaskMemFree(pidl)
End Function