by Nokiocab25 (3 Submissions)
Category: Windows API Call/Explanation
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Mon 6th January 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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)
VBcoders
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