Specify a Path with Standard Folder Browsing

Visual Basic does not directly support the Windows standard folder browsing dialog, but it’s easy to add by using the SHBrowseForFolder API function. The API declarations file included with VB doesn’t have the shell operations APIs listed, but they can be easily translated from the C versions. The Platform SDK contains all the C versions of every constant and structure. You can download it a few clicks from this page: msdn.microsoft.com/developer/sdk.

When you use the SendMessage API call in the BrowseCallbackProc procedure, make sure aStr has something in it. VB will crash without a startup path, so don’t make the call if there’s nothing to do.

Note that I use the lParam element of the BROWSEINFO structure to hold the object pointer of the TextBox containing the default path. That makes it easy to retrieve the default path from any number of source text boxes.

The GetAddress function is necessary because B.lpCallBack = AddressOf BrowseCallbackProc isn’t a valid statement.

‘ Form code

Private Sub cmdBrowse_Click()
    Dim B As BROWSEINFO, lItems As Long, aStr As String

    B.hWndOwner = hwnd
    B.pszTitle = "Browse sample"
    B.lpCallback = GetAddress(AddressOf BrowseCallbackProc)
    B.lParam = ObjPtr(Text1)

    lItems = SHBrowseForFolder(B)

    If lItems Then
        aStr = Space$(MAX_PATH)
        SHGetPathFromIDList lItems, aStr
        Text1.Text = Left$(aStr, InStr(aStr, Chr$(0)))
        LocalFree lItems
    End If
End Sub

‘ Module code
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) _
    As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" (lpBrowseInfo As Any) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, _
    ByVal pszPath As String) As Long

Type BROWSEINFO
    hWndOwner As Long
    pdilRoot As Long
    pszDisplayName As String
    pszTitle As String
    ulFlags As Long
    lpCallback As Long
    lParam As Long
    iImage As Long
End Type

Public Const WM_USER = &H400
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SETSELECTIONA = (WM_USER + 102)
Public Const MAX_PATH = 260

Public Function BrowseCallbackProc(ByVal hwnd As Long, ByVal Msg _
    As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case Msg
        Case BFFM_INITIALIZED
            Dim aStr As String, oText As Object
            CopyMemory oText, lParam, 4
            aStr = oText.Text
            If Len(aStr) Then
                If Len(aStr) > 3 Then
                    If Right$(aStr, 1) = "\" Then aStr = _
                        Left$(aStr, Len(aStr) - 1)
                End If
                SendMessage hwnd, BFFM_SETSELECTIONA, True, _
                    ByVal aStr
            End If
    End Select
End Function

Public Function GetAddress(ByVal lParam As Long) As Long
    GetAddress = lParam
End Function