• Home
 · 
• Windows API Call/Explanation
 · 
• Browse for Folder Dialog Box

Browse for Folder Dialog Box

Browse for Folder Dialog Box

API Declarations



Private Const CSIDL_DRIVES = &H11

Private Const BIF_EDITBOX = &H10
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_STATUSTEXT = &H4

Private Const BFFM_ENABLEOK = &H465
Private Const BFFM_SETSELECTION = &H466
Private Const BFFM_SETSTATUSTEXT = &H464
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_VALIDATEFAILED = 3

Private m_strCurrentPath As String

Private Type BROWSEINFO
hwndOwner 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

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, _
ByVal nFolder As Long, ppidl As Long) As Long

Private Declare Function SendMessage Lib "user32.dll" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, _
wParam As Any, lParam As Any) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpbi As BROWSEINFO) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)



Rate Browse for Folder Dialog Box

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

    Dim hBrowseInfo As BROWSEINFO
    Dim dwShellReturn As Long
    Dim dwReturn As Long
    
    With hBrowseInfo
        .hwndOwner = hWnd
        .pszDisplayName = Space(260)
        .lpszTitle = strTitle
        .ulFlags = BIF_EDITBOX + BIF_RETURNONLYFSDIRS + BIF_STATUSTEXT
        .lpfn = DummyFunc(AddressOf BrowseCallbackProc)
        .lParam = 0
        .iImage = 0
    End With
    
    dwReturn = SHGetSpecialFolderLocation(hWnd, CSIDL_DRIVES, _
        hBrowseInfo.pidlRoot)
    
    dwShellReturn = SHBrowseForFolder(hBrowseInfo)
    
    If dwShellReturn <> 0 Then
       
        hBrowseInfo.pszDisplayName = Left$(hBrowseInfo.pszDisplayName, _
            InStr(hBrowseInfo.pszDisplayName, vbNullChar) - 1)
        
        m_strCurrentPath = Space(260)
        dwReturn = SHGetPathFromIDList(dwShellReturn, m_strCurrentPath)
        
        If dwReturn = 0 Then
            m_strCurrentPath = vbNullString
        Else
            m_strCurrentPath = Left(m_strCurrentPath, _
                InStr(m_strCurrentPath, vbNullChar) - 1)
        End If
        
        Call CoTaskMemFree(dwShellReturn)
    End If
    
    Call CoTaskMemFree(hBrowseInfo.pidlRoot)
    BrowseForFolder = m_strCurrentPath
End Function

Private Function DummyFunc(ByVal lParam As Long) As Long
  DummyFunc = lParam
End Function

Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, _
    ByVal lParam As Long, ByVal lpData As Long) As Long

    Select Case uMsg
        Case BFFM_INITIALIZED
            Call SendMessage(hWnd, BFFM_SETSELECTION, _
                ByVal CLng(1), ByVal m_strCurrentPath)
    End Select
    
    BrowseCallbackProc = 0
End Function