'In Module1.bas
Option Explicit
'***************************************************************
' Opens a common dialog window to browse for a folder
' Returns the path to the folder selected as a string
'***************************************************************
'***************************************************************
' Browse Dialog Constants
'***************************************************************
Public Type BROWSEINFO
hOwner As Long 'Handle to window's owner
pidlRoot As Long 'Pointer to an item identifier list
pszDisplayName As Long 'Pointer to a buffer that receives the display name of the folder selected
lpszTitle As Long 'Pointer to a null-terminated string that is displayed above the tree view control in the dialog box
ulFlags As Long 'Value specifying the types of folders to be listed in the dialog box as well as other options
lpfn As Long 'Address an application-defined function that the dialog box calls when events occur
lParam As Long 'Application-defined value that the dialog box passes to the callback function (if one is specified).
iImage As Long 'Variable that receives the image associated with the selected folder. The image is specified as an index to the system image list.
End Type
'***************************************************************
' Browse Dialog Flags & Constants
'***************************************************************
Public Const BIF_RETURNONLYFSDIRS = &H1 'Only returns file system directories
Public Const BIF_DONTGOBELOWDOMAIN = &H2 'Does not include network folders below the domain level
Public Const BIF_STATUSTEXT = &H4 'Includes a status area in the dialog box. The callback function can set the status text by sending messages to the dialog box.
Public Const BIF_RETURNFSANCESTORS = &H8 'Only returns file system ancestors
Public Const BIF_BROWSEFORCOMPUTER = &H1000 'Only returns computers
Public Const BIF_BROWSEFORPRINTER = &H2000 'Only returns (network) printers
Public Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Public Const MAX_PATH = 255
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" (ByRef lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" (ByRef pidl As Long, ByVal pszPath As String) As Long
Public Function SelectFolder(ByRef frm As Form, Optional sDialTitle As String = "Select a folder") As String
On Error Resume Next
Dim bi As BROWSEINFO
Dim sPath As String
Dim lPos As Long
'Fill the BROWSEINFO structure with the needed data.
With bi
.hOwner = frm.hWnd
.pidlRoot = 0& 'Root folder to browse from, or desktop if Null
.lpszTitle = lstrcat(sDialTitle, "") 'Message to display in dialog
.ulFlags = BIF_BROWSEINCLUDEFILES 'the type of folder to return
End With
'show the browse for folders dialog
lPos = SHBrowseForFolder(bi)
'the dialog has closed, so parse & display the user's
'returned folder selection contained in pidl
sPath = Space$(MAX_PATH)
If lPos Then
SHGetPathFromIDList ByVal lPos, ByVal sPath
CoTaskMemFree lPos
lPos = InStr(sPath, vbNullChar)
sPath = Left$(sPath, lPos - 1)
SelectFolder = Right$(sPath, Len(sPath) - InStrRev(sPath, "\"))
Else
SelectFolder = ""
End If
End Function
'Behind Form1.frm
Option Explicit
Private Sub Command1_Click()
Dim sFile As String
sFile = SelectFolder(Me, "Select File")
MsgBox sFile
End Sub