Attention. This project is no longer being updated. I've included this dialog in my CmdDialogEx class which already had the standard Open/Save file dialogs. Any improvements to this code will be found in that other project.
This is a unicode-compatible "Browse For Folder" dialog implementation. It offers options to customize the dialog beyond simple examples you may have seen. I have moved this to its own thread from the Unicode File Open/Save Dialog thread. It was becoming a bit confusing whether posts were talking about that solution or this solution.
Before I go too far into this, let me link an example from dilettante where CreateObject can be used. If you don't need any special customization, that is a fine solution and very simple to code.
The attached class has lots of methods/properties and nearly all of them are well-commented within the class. Therefore, not going to list them in this thread with few exceptions:
SelectedFolder contains a path/filename and/or PIDL of the item selected by the user.
InitialDirectory will attempt to select that as the folder first displayed/selected by the dialog
PathToPIDL is a convenience function to convert a path to a PIDL
PIDLtoPath is a convenience function to convert a PIDL to a path, if possible
ShowBrowseForFolder is the function that activates the dialog
BrowseForFolderMsgEnum lists common messages that can be sent to dialog via SendMessage
BrowseForFolderCallBackEnum lists common messages received in the dialog callback procedure
BrowseForFolderDialogFlagsEnum lists all the available flags the dialog may support (version limited)
Sample call might look like this:
Code:
Dim cb As UnicodeBrowseFolders
Set cb = New UnicodeBrowseFolders
With cb
.DialogTitle = "Select Folder To Save Report"
.Flags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE
.InitialDirectory = "C:\blah\blah\blah\Reports"
End With
If cb.ShowBrowseForFolder(Me.hWnd) = True Then
' do what you need with the selection
' cb.SelectedFolder() returns selected path if a non-virtual path selected
' cb.SelectedFolder(True) returns a PIDL whether virtual path selected or not
End If
A note about selecting 2 or more of the Flags property values. OR them together DO NOT add them together. The following returns different results:
Code:
(BIF_DONTGOBELOWDOMAIN Or BIF_USENEWUI Or BIF_NEWDIALOGSTYLE) = 82
(BIF_DONTGOBELOWDOMAIN + BIF_USENEWUI + BIF_NEWDIALOGSTYLE) = 146 << wrong
Here's an example of asking for events. The class can self-hook the dialog and send events that it receives to your form if you choose. There are three events that can be sent:
1) Initialized. The dialog's hWnd is provided. You are kinda unlimited to what you can do in this event.
2) SelectionChanged. Event sent whenever the dialog folder selection changes
3) CallBackMsg. Catch-all of other events forwarded from the dialog
Just one note. WantEvents property is ignored if you set the CustomHookProc property which means you are hooking the dialog and the class will not.
Code:
' you must declare the dialog using: WithEvents
Private WithEvents FolderBrowser As UnicodeBrowseFolders
' setup your dialog
Private Sub ShowBrowser()
Set FolderBrowser = New UnicodeBrowseFolders
With FolderBrowser
.WantEvents = True
... set other properties
End With
If FolderBrowser.ShowBrowseForFolder(Me.hWnd) = True Then
' handle selected folder
End If
End Sub
' respond/review events, i.e.,
Private Sub FolderBrowser_CallBackMsg(ByVal hWnd As Long, ByVal Message As Long, ByVal lParam As Long, ByVal UserParam As Long, CloseDialog As Boolean)
End Sub
Private Sub FolderBrowser_Initialized(ByVal hWnd As Long, ByVal UserParam As Long)
End Sub
Private Sub FolderBrowser_SelectionChanged(ByVal hWnd As Long, ByVal pPIDL As Long, ByVal UserParam As Long)
End Sub
Last edited by LaVolpe; Aug 5th, 2018 at 07:15 PM.
Reason: added WantEvents example
Insomnia is just a byproduct of, "It can't be done"
Here is how you can further customize the dialog. It is only limited by your subclassing skills and imagination:
Strongly recommended that you set your own hook procedure for the dialog. Not recommended that you activate subclassing from within any events that could otherwise be forwarded via the class WantEvents property.
1. Add an Implementation class to your project. This allows you to have the subclass messages sent to any form, usercontrol, class
Code:
' Name this class: IBrowserSubclasser
Option Explicit
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _
ByVal uIdSubclass As Long, ByVal dwRefData As Long, _
bHandled As Boolean) As Long
' dialog subclass messages
' bHandled set to True if function return value must be used else forward to default window procedure
End Function
Public Sub CallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long)
' dialog callback messages
End Sub
2. Add a bas module to your project to support subclassing.
Code:
Option Explicit
Private Declare Function DefSubclassProc Lib "comctl32.dll" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32.dll" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function SendMessageW Lib "user32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Public m_BrowserInitFolder As String ' set this before showing the dialog
Public Function GetBrowserCallBack() As Long
' assign this to dialog's CustomHookProc property
GetBrowserCallBack = pvAddressOf(AddressOf pvBrowseCallbackProc)
End Function
Private Function pvAddressOf(inAddress As Long) As Long ' helper function
pvAddressOf = inAddress
End Function
Private Sub pvUnsubclassBrowser(hWnd As Long, uIdSubclass As Long) ' helper function
RemoveWindowSubclass hWnd, AddressOf pvBrowseCallbackProc, uIdSubclass
End Sub
Private Function ObjFromPointer(lParam As Long) As IBrowserSubclasser ' helper function
Dim o As Object
CopyMemory o, lParam, 4&
Set ObjFromPointer = o
CopyMemory o, 0&, 4&
End Function
Private Function pvBrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal lpData As Long) As Long
Static bInitSel As Boolean
Select Case uMsg
Case BFFM_INITIALIZED
' http://msdn.microsoft.com/en-us/library/aa452875.aspx
' the 3rd parameter of SendMessageW is either zero or non-zero
' zero :: 4th param is a PIDL
' non-zero :: 4th param is yourDesiredInitialDirectoryPath string
' you can set your initial folder now...
If m_BrowserInitFolder = vbNullString Then
bInitSel = False
Else
bInitSel = True
SendMessageW hWnd, BFFM_SETSELECTIONW, 1&, ByVal StrPtr(m_BrowserInitFolder)
End If
' you can set the titlebar with SetWindowText API
' you can subclass the dialog if you want.
' lpData is set as dialog's CustomHookData property like so:
' -------------------------------------
' :: in form's declaration section that shows the dialog...
' Implements IBrowserSubclasser
' :: set's dialog property before showing dialog
' .CustomHookData = ObjPtr(Me)
' :: of course, form needs to review messages sent to it
If lpData <> 0& Then
SetWindowSubclass hWnd, AddressOf pvWndProc, lpData, 0&
ObjFromPointer(lpData).CallbackProc hWnd, uMsg, lp
End If
Case BFFM_SELCHANGED
If bInitSel Then ' tweak to ensure selected item is visible in tree (call selection twice)
bInitSel = False
SendMessageW hWnd, BFFM_SETSELECTIONW, 1&, ByVal StrPtr(m_BrowserInitFolder)
End If
' user selected a new folder/path
' can set the status text with SendMessageW if desired
If lpData <> 0& Then ObjFromPointer(lpData).CallbackProc hWnd, uMsg, lp
Case BFFM_VALIDATEFAILED, BFFM_VALIDATEFAILED + 1&
' you asked for edit box validation when setting the flags
' user typed invalid path in edit control, return 0 to close dialog else return non-zero
If lpData <> 0& Then ObjFromPointer(lpData).CallbackProc hWnd, uMsg, lp
Case BFFM_IUNKNOWN
If lpData <> 0& Then ObjFromPointer(lpData).CallbackProc hWnd, uMsg, lp
End Select
End Function
Private Function pvWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _
ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
' subclass procedure
Select Case uMsg
Case 2& ' WM_DESTROY, self unsubclass
pvUnsubclassBrowser hWnd, uIdSubclass
pvWndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
Case Else
Dim bHandled As Boolean
pvWndProc = ObjFromPointer(uIdSubclass).WindowProc(hWnd, uMsg, wParam, lParam, _
uIdSubclass, dwRefData, bHandled)
If bHandled = False Then pvWndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Select
End Function
3. Set up your form, usercontrol, class to recieve subclass messages and show the dialog
Code:
' in the declarations section
Implements IBrowserSubclasser
Private Sub pvShowBrowseForFolder()
Dim f As UnicodeBrowseFolders
Set f = New UnicodeBrowseFolders
With f
' set the two hook-related properties
.CustomHookProc = GetBrowserCallBack()
.CustomHookData = ObjPtr(Me)
' if wanting to start at a specifc folder, set bas module's public variable
m_BrowserInitFolder = "C:\Windows\System32"
' set other properties, especially the Flags property
End With
If f.ShowBrowseForFolder(Me.hWnd) = True Then
MsgBox f.SelectedFolder
End If
End Sub
Private Function IBrowserSubclasser_WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long, _
ByVal uIdSubclass As Long, ByVal dwRefData As Long, bHandled As Boolean) As Long
' Debug.Print "message "; uMsg
End Function
Private Sub IBrowserSubclasser_CallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long)
' dialog callback messages
End Sub
Last edited by LaVolpe; Jul 24th, 2017 at 12:12 PM.
Insomnia is just a byproduct of, "It can't be done"
Brought to my attention was the fact that the optional InitialDirectory property, when set, would correctly select the desired folder but the dialog would not scroll to the item in its treeview. This appears to be a Microsoft logic flaw related to one or more Flags property settings. There are at least two solutions:
1) Locate the treeview during the dialog initialize event, then use SendMessage API for TVM_ENSUREVISIBLE.
2) Set the desired folder selection twice: once during initialize and again after it was registered and a selection-change event occurs.
Since solution #2 is far less code, it was chosen and reposted. If any issues are noted regarding this fix, I'll consider going with solution #1 above.
Insomnia is just a byproduct of, "It can't be done"
Thanks a lot for all the help and advice, including the recent fixes.
I used this UnicodeBrowseFolders and I guess there is a little problem, but I am not sure.
I may be totally wrong, but I say it anyway. Please correct me if I am wrong:
I have a form named frmMain.
On it, I have a button. When the user clicks that button, a new form named Form1 pops up:
Code:
Private Sub cmdLoadForm1_Click()
Load Form1
End Sub
Then on this new form I have an InkEdit textbox that is supposed to hold a folder path.
When the user double-clicks on that InkEdit, this UnicodeBrowseFolders pops up, so that the user can browse and select a folder.
This works fine.
However, this UnicodeBrowseFolders is modal only as far as Form1 is concerned. When this UnicodeBrowseFolders is on the screen the user cannot navigate to Form1 (until he selects a folder or clicks cancel) and that is the expected behaviour and is fine. The user should not be allowed to navigate to Form1 while UnicodeBrowseFolders is on the screen.
But, the user can easily use Alt+Tab to navigate to frmMain with no problem.
Shouldn't that kind of navigation be also blocked?
Shouldn't this UnicodeBrowseFolders be modal with regards to the entire application (the whole vbp project and all its forms)?
Currently UnicodeBrowseFolders is modal only with regards to Form1 not with regards to the whole application.
Please advise.
Regrads.
Ilia