' This function compensates for the fact that the AddressOf operator
' can only be used in a function call. It returns the parameter
' passed to it.
Public Function DummyFunc(ByVal param As Long) As Long
DummyFunc = param
End Function
' This function is the callback function for the dialog box. It sets
' the selected folder to C:\StartHere when the box is initialized.
Public Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
Dim pathstring As String ' name of path to set by default
Dim retval As Long ' return value
' If the BFFM_INITIALIZED message is received, set the
' default selection to C:\StartHere.
Select Case uMsg
Case BFFM_INITIALIZED
pathstring = "C:\StartHere" ' the path to make the default selection
' Send a message to the dialog box telling it to select this path.
' Note the use of ByVal and the CLng function here.
retval = SendMessage(hwnd, BFFM_SETSELECTION, ByVal CLng(1), ByVal pathstring)
End Select
BrowseCallbackProc = 0 ' the function should always return 0
End Function
' *** Place the following code where you want to open the ***
' *** Browse for Folder dialog box. ***
Dim bi As BROWSEINFO ' structure passed to the function
Dim pidl As Long ' PIDL to the user's selection
Dim physpath As String ' string used to temporarily hold the physical path
Dim retval As Long ' return value
' Initialize the structure to be passed to the function.
bi.hwndOwner = Form1.hWnd ' window Form1 is the owner of the dialog box
' Specify the My Computer virtual folder as the root
retval = SHGetSpecialFolderLocation(Form1.hWnd, CSIDL_DRIVES, bi.pidlRoot)
' Make room in the buffer to get the [virtual] folder's display name
bi.pszDisplayName = Space(260)
bi.lpszTitle = "Please choose a folder." ' Message displayed to the user
bi.ulFlags = 0 ' no flags are needed here
' Identify the callback function to use for the dialog box. Note
' how our DummyFunc is needed because AddressOf only works
' inside a function call.
bi.lpfn = DummyFunc(AddressOf BrowseCallbackProc)
bi.lParam = 0 ' the callback function here doesn't need this
bi.iImage = 0 ' this will be set by the function
' Open the Browse for Folder dialog box.
pidl = SHBrowseForFolder(bi)
' If the user selected something, display its display name
' and its physical location on the system.
If pidl <> 0 Then
' Remove the empty space from the display name variable.
bi.pszDisplayName = Left(bi.pszDisplayName, InStr(bi.pszDisplayName, vbNullChar) - 1)
Debug.Print "The user selected: "; bi.pszDisplayName
' If the folder is not a virtual folder, display its physical location.
physpath = Space(260) ' make room in the buffer
retval = SHGetPathFromIDList(pidl, physpath)
If retval = 0 Then
Debug.Print "Physical Location: (virtual folder)"
Else
' Remove the empty space and display the result.
physpath = Left(physpath, InStr(physpath, vbNullChar) - 1)
Debug.Print "Physical Location: "; physpath
End If
' Free the pidl returned by the function.
CoTaskMemFree pidl
End If