Private Structure BROWSEINFO
Dim hOwner As Integer
Dim pidlRoot As Integer
Dim pszDisplayName As String
Dim lpszTitle As String
Dim ulFlags As Integer
Dim lpfn As Integer
Dim lParam As Integer
Dim iImage As Integer
End Structure
Private Const BIF_RETURNONLYFSDIRS As Short = &H1S
Private Const BIF_DONTGOBELOWDOMAIN As Short = &H2S
Private Const BIF_STATUSTEXT As Short = &H4S
Private Const BIF_RETURNFSANCESTORS As Short = &H8S
Private Const BIF_BROWSEFORCOMPUTER As Short = &H1000S
Private Const BIF_BROWSEFORPRINTER As Short = &H2000S
Private Const MAX_PATH As Short = 256
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal nPidl As Integer, ByVal pszPath As String) As Integer
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (ByRef lpBrowseInfo As BROWSEINFO) As Integer
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV_Renamed As Integer)
Public Function BrowseFolder(ByRef sTitle As String, ByRef frm As System.Windows.Forms.Form) As String
On Error Resume Next
Dim browse As BROWSEINFO
Dim nPidl As Integer
Dim sPath As String
Dim nPos As Short
Dim sReturn As String
sReturn = ""
browse.hOwner = frm.Handle.ToInt32
browse.pidlRoot = 0
browse.lpszTitle = sTitle
browse.ulFlags = BIF_RETURNONLYFSDIRS
nPidl = SHBrowseForFolder(browse)
sPath = Space(MAX_PATH)
If SHGetPathFromIDList(nPidl, sPath) Then
nPos = InStr(sPath, Chr(0))
sReturn = Left(sPath, nPos - 1)
End If
Call CoTaskMemFree(nPidl)
BrowseFolder = sReturn
End Function
EXAMPLE:
Dim ChosenFolder As String = BrowseFolder("Where Do You Want To Place Your Files", Me)