Library code snippets
Browse For Folder VBA
The Code
This code lets you display a Browse for Folder dialog in VBA.
Also, this code has a few minor limitations:
- You can not go below the InitDir level of the folder selection dialoge than the one specified.
- If you use this as is, you can not go below the desktop in other words.
I updated this to include all constants known to me.
Otherwise if someone has a list of the dhcCSI constants, I'd be more than happy to post that as an amendment here. A sub for calling the function is shown at the very end of this. Paste all of the code below into a module.
'this will allow you to browse for folder starting at your desktop.
Public Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
pszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Const MAX_PATH As Long = 260
Const dhcErrorExtendedError = 1208&
Const dhcNoError = 0&
'specify root dir for browse for folder by constants
'you can also specify values by constants for searhcable folders and options.
const dhcCSIdlDesktop = &H0
const dhcCSIdlPrograms = &H2
const dhcCSIdlControlPanel = &H3
const dhcCSIdlInstalledPrinters = &H4
const dhcCSIdlPersonal = &H5
const dhcCSIdlFavorites = &H6
const dhcCSIdlStartupPmGroup = &H7
const dhcCSIdlRecentDocDir = &H8
const dhcCSIdlSendToItemsDir = &H9
const dhcCSIdlRecycleBin = &HA
const dhcCSIdlStartMenu = &HB
const dhcCSIdlDesktopDirectory = &H10
const dhcCSIdlMyComputer = &H11
const dhcCSIdlNetworkNeighborhood = &H12
const dhcCSIdlNetHoodFileSystemDir = &H13
const dhcCSIdlFonts = &H14
const dhcCSIdlTemplates = &H15
'constants for limiting choices for BrowseForFolder Dialog
const dhcBifReturnAll = &H0
const dhcBifReturnOnlyFileSystemDirs = &H1
const dhcBifDontGoBelowDomain = &H2
const dhcBifIncludeStatusText = &H4
const dhcBifSystemAncestors = &H8
const dhcBifBrowseForComputer = &H1000
const dhcBifBrowseForPrinter = &H2000
'... you can get a lot more of these values from your integrated API viewer for constant specifcation or go to AllPai.net and see their samples.
Public Declare Function SHBrowseForFolder Lib "shell32.dll" (ByRef lpbi As BROWSEINFO) As Long
'corrected
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, ByRef pidl As Long) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Function BrowseForFolder(ByVal lngCSIDL As Long, _
ByVal lngBiFlags As Long, _
strFolder As String, _
Optional ByVal hWnd As Long = 0, _
Optional pszTitle As String = "Select Folder") As Long
Dim usrBrws As BROWSEINFO
Dim lngReturn As Long
Dim lngIDL As Long
If SHGetSpecialFolderLocation(hWnd, lngCSIDL, lngIDL) = 0 Then
'set up the browse structure here
With usrBrws
.hwndOwner = hWnd
.pidlRoot = lngIDL
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.pszTitle = pszTitle
.ulFlags = lngBiFlags
End With
'open the dialog
lngIDL = SHBrowseForFolder(usrBrws)
'if successful
If lngIDL Then strFolder = String$(MAX_PATH, vbNullChar)
'resolve the long value form the lngIDL to a real path
If SHGetPathFromIDList(lngIDL, strFolder) Then
strFolder = Left(strFolder, InStr(1, strFolder, vbNullChar))
lngReturn = dhcNoError 'to show there is no error.
Else
'nothing real is available.
'return a virtual selection
strFolder = Left(usrBrws.pszDisplayName, InStr(1, usrBrws.pszDisplayName, vbNullChar))
lngReturn = dhcNoError 'to show there is no error.
End If
Else
lngReturn = dhcErrorExtendedError 'something went wrong
End If
BrowseForFolder = lngReturn
End Function
Sub GetBrowse()
Dim strPath As String
'now fill the strPath with the choice by user
Call BrowseForFolder(dhcCSIdlDesktop, dhcBifReturnOnlyFileSystemDirs, _
strPath, pszTitle:="Select a folder:")
End Sub
Related articles
Related discussion
-
Problems with VBA User Forms on Excel
by Veritant (1 replies)
-
Problems with User Forms
by Uncle (1 replies)
-
Outlook VBA query
by James Crowley (1 replies)
-
problem with a progressbar : it dispears
by Uncle (1 replies)
-
Access, Calender dates, Strings and SQL
by Uncle (1 replies)
Events coming up
-
Jun
16
Code Generation 2009
Cambridge, United Kingdom
A developer event with a practical focus on helping people get to grips with code generation tools and technologies.
Thanks, Found the answer in an older post!
When I press the cancel button on the browse dialog, I get a nasty error!
Automation error
The object invoked has disconnected from its clients.
How does one correct this?
To open a dialog looking for files, simply use:
Dim dial As New CommonDialog
dial.InitDir = "C:\MyFolder\"
dial.ShowOpen
TextBox1.Text = dial.fileName
I.e. You don't need the code in question, unless you only want to reference a path, then the commonDialog doesn't work, since it require the user to select a file.
I need to know...
1. How to start browsing from a directory stored in a variable, rather than always starting at the desktop (it takes a while to browse to the right directory on the network) (I know this was asked, but I don't know if that person got their answer outside of the board).
2. How to include files, and not just directories.
I'm fairly new to VBA, and don't really get the "&H8".
I welcome anyone to help.... Thank you!
Steve
Hi
I use this code in a vba project and it works well.
But the window is not displayed at the center of the screen.
How can I do that ?
Thanks
Mikael
If lngIDL <> 0 Then //check the condition here.. it work fine now
If SHGetPathFromIDList(lngIDL, strFolder) Then
strFolder = Left(strFolder, InStr(1, strFolder, vbNullChar))
lngReturn = dhcNoError 'to show there is no error.
Else
'nothing real is available.
'return a virtual selection
strFolder = Left(usrBrws.pszDisplayName, InStr(1, usrBrws.pszDisplayName, vbNullChar))
lngReturn = dhcNoError 'to show there is no error.
End If
End If
thanks mrjdesign,
but I've already found my solution...
bye.
Do a search for SYSTEM FOLDERS or SPECIAL FOLDERS here. I know James posted a good example for accessing special directories in a similar code.
This is done normally/best through the use of simple API calls.
The example I posted was simply for the use in VBA.
In VB I know you can specify the startup folder simply by settings the property therefor to the desired startup location. VBA is a bit different than VB in this function. (Not to much different but still)
Hi andresmarenco12,
have you found the way to start the dialog box from the desired folder?
I have the same problem.
Thanks.
Franx.
Hi raj2811,
have you found the way to start the dialog box from the desired folder?
I have the same problem.
Thanks.
Franx.
this code cannot be applied to ASP page
is there anything i can do to make it compatible?
What should i do so that the Dialog Box starts from where the folder was selected last time (not the default folder). ?
Didnt Read your first message, once added, fixed problem
Great
Works well on browse but if I select cancel I get a disonnect from client and my system shuts down
Hi,
There's a problem when you want to use this function to get a folder for saving a file; the path contains a Null-character, which fauls up proper operation.
Here's an updated/changed version of the function only.
This listing contains the correct error-handling.
'this will allow you to browse for folder starting at your desktop.
Public Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
pszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Const MAX_PATH As Long = 260
Const dhcErrorExtendedError = 1208&
Const dhcNoError = 0&
'specify root dir for browse for folder by constants
'you can also specify values by constants for searhcable folders and options.
Const dhcCSIdlDesktop = &H0
Const dhcCSIdlPrograms = &H2
Const dhcCSIdlControlPanel = &H3
Const dhcCSIdlInstalledPrinters = &H4
Const dhcCSIdlPersonal = &H5
Const dhcCSIdlFavorites = &H6
Const dhcCSIdlStartupPmGroup = &H7
Const dhcCSIdlRecentDocDir = &H8
Const dhcCSIdlSendToItemsDir = &H9
Const dhcCSIdlRecycleBin = &HA
Const dhcCSIdlStartMenu = &HB
Const dhcCSIdlDesktopDirectory = &H10
Const dhcCSIdlMyComputer = &H11
Const dhcCSIdlNetworkNeighborhood = &H12
Const dhcCSIdlNetHoodFileSystemDir = &H13
Const dhcCSIdlFonts = &H14
Const dhcCSIdlTemplates = &H15
'constants for limiting choices for BrowseForFolder Dialog
Const dhcBifReturnAll = &H0
Const dhcBifReturnOnlyFileSystemDirs = &H1
Const dhcBifDontGoBelowDomain = &H2
Const dhcBifIncludeStatusText = &H4
Const dhcBifSystemAncestors = &H8
Const dhcBifBrowseForComputer = &H1000
Const dhcBifBrowseForPrinter = &H2000
'... you can get a lot more of these values from your integrated API viewer for constant specifcation or go to AllPai.net and see their samples.
Public Declare Function SHBrowseForFolder Lib "shell32.dll" (ByRef lpbi As BROWSEINFO) As Long
'corrected
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, ByRef pidl As Long) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Function BrowseForFolder(ByVal lngCSIDL As Long, _
ByVal lngBiFlags As Long, _
strFolder As String, _
Optional ByVal hWnd As Long = 0, _
Optional pszTitle As String = "Select Folder") As Long
Dim usrBrws As BROWSEINFO
Dim lngReturn As Long
Dim lngIDL As Long
If SHGetSpecialFolderLocation(hWnd, lngCSIDL, lngIDL) = 0 Then
'set up the browse structure here
With usrBrws
.hwndOwner = hWnd
.pidlRoot = lngIDL
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.pszTitle = pszTitle
.ulFlags = lngBiFlags
End With
'open the dialog
lngIDL = SHBrowseForFolder(usrBrws)
'if successful
If lngIDL = 0 Then
strFolder = ""
Else
strFolder = String$(MAX_PATH, vbNullChar)
End If
'resolve the long value form the lngIDL to a real path
If SHGetPathFromIDList(lngIDL, strFolder) Then
strFolder = Left(strFolder, InStr(1, strFolder, vbNullChar) - 1)
If InStr((Len(strFolder)), strFolder, "\") Then
strFolder = strFolder
Else
strFolder = strFolder & "\"
End If
lngReturn = dhcNoError 'to show there is no error.
Else
'nothing real is available.
'return a virtual selection
strFolder = Left(usrBrws.pszDisplayName, InStr(1, usrBrws.pszDisplayName, vbNullChar))
lngReturn = dhcNoError 'to show there is no error.
End If
Else
lngReturn = dhcErrorExtendedError 'something went wrong
End If
BrowseForFolder = lngReturn
End Function
Search the file samples in the Visual Basic Examples for
A) Browse for folder... folders only
B) Browse for file...
for selecting files.
Their two different commands.
I used your code. It works well, but it does not allow the user to view the files that are in the folder that is selected. If let's say I need to write a program that will prompt the user to choose the directory that they want to open, eg Drive A, and then, open drive A and list out all the files in one window, so that the user can just choose the file that he wants to open, how do I do it?
how can I make the Browse Folder Dialog start in another folder, like "C:\My Music"
How can I browse only CD Drives?
I need a Flag to put in .pidlRoot, but I don't know it
Please, it's VERY URGENT
The actual cancel code in case you did'nt quite understand the above can be written as follows:
If lngIDL = 0 Then
strFolder = ""
Else
strFolder = String$(MAX_PATH, vbNullChar)
End If
Thanks to the guy that wrote majority of code, was a great help! Hope this helps anyone else.
You have to change the following original postet Code
If lngIDL Then strFolder = String$(MAX_PATH, vbNullChar)
'resolve the long value form the lngIDL to a real path
If SHGetPathFromIDList(lngIDL, strFolder) Then
strFolder = Left(strFolder, InStr(1, strFolder, vbNullChar))
lngReturn = dhcNoError 'to show there is no error.
Else
'nothing real is available.
'return a virtual selection
strFolder = Left(usrBrws.pszDisplayName, InStr(1, usrBrws.pszDisplayName, vbNullChar))
lngReturn = dhcNoError 'to show there is no error.
End If
to
If lngIDL Then
strFolder = String$(MAX_PATH, vbNullChar)
'resolve the long value form the lngIDL to a real path
If SHGetPathFromIDList(lngIDL, strFolder) Then
strFolder = Left(strFolder, InStr(1, strFolder, vbNullChar))
lngReturn = dhcNoError 'to show there is no error.
Else
'nothing real is available.
'return a virtual selection
strFolder = Left(usrBrws.pszDisplayName, InStr(1, usrBrws.pszDisplayName, vbNullChar))
lngReturn = dhcNoError 'to show there is no error.
End If
Else
lngReturn = dhcErrorExtendedError 'something went wrong
End If
and all works fine
wildspitze
if I change the Code For Cancel Solution then OK does not work
Its Urgent
In the function BrowseForFolder, change the following lines...
If lngIDL Then strFolder = String$(MAX_PATH, vbNullChar)
as follow...
If lngIDL = 0 Then
strFolder = ""
BrowseForFolder = dhcNoError
Exit Function
End If
Excepting this bug, great job!
thanx Mike J
Updated version as follows:
'this will allow you to browse for folder starting at your desktop.
Public Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
pszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Const MAX_PATH As Long = 260
Const dhcErrorExtendedError = 1208&
Const dhcNoError = 0&
'specify root dir for browse for folder by constants
'you can also specify values by constants for searhcable folders and options.
Const dhcCSIdlDesktop = &H0
Const dhcCSIdlPrograms = &H2
Const dhcCSIdlControlPanel = &H3
Const dhcCSIdlInstalledPrinters = &H4
Const dhcCSIdlPersonal = &H5
Const dhcCSIdlFavorites = &H6
Const dhcCSIdlStartupPmGroup = &H7
Const dhcCSIdlRecentDocDir = &H8
Const dhcCSIdlSendToItemsDir = &H9
Const dhcCSIdlRecycleBin = &HA
Const dhcCSIdlStartMenu = &HB
Const dhcCSIdlDesktopDirectory = &H10
Const dhcCSIdlMyComputer = &H11
Const dhcCSIdlNetworkNeighborhood = &H12
Const dhcCSIdlNetHoodFileSystemDir = &H13
Const dhcCSIdlFonts = &H14
Const dhcCSIdlTemplates = &H15
'constants for limiting choices for BrowseForFolder Dialog
Const dhcBifReturnAll = &H0
Const dhcBifReturnOnlyFileSystemDirs = &H1
Const dhcBifDontGoBelowDomain = &H2
Const dhcBifIncludeStatusText = &H4
Const dhcBifSystemAncestors = &H8
Const dhcBifBrowseForComputer = &H1000
Const dhcBifBrowseForPrinter = &H2000
'... you can get a lot more of these values from your integrated API viewer for constant specifcation or go to AllPai.net and see their samples.
Public Declare Function SHBrowseForFolder Lib "shell32.dll" (ByRef lpbi As BROWSEINFO) As Long
'corrected
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, ByRef pidl As Long) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Function BrowseForFolder(ByVal lngCSIDL As Long, _
ByVal lngBiFlags As Long, _
strFolder As String, _
Optional ByVal hWnd As Long = 0, _
Optional pszTitle As String = "Select Folder") As Long
Dim usrBrws As BROWSEINFO
Dim lngReturn As Long
Dim lngIDL As Long
If SHGetSpecialFolderLocation(hWnd, lngCSIDL, lngIDL) = 0 Then
'set up the browse structure here
With usrBrws
.hwndOwner = hWnd
.pidlRoot = lngIDL
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.pszTitle = pszTitle
.ulFlags = lngBiFlags
End With
'open the dialog
lngIDL = SHBrowseForFolder(usrBrws)
'if successful
If lngIDL Then
strFolder = String$(MAX_PATH, vbNullChar)
'resolve the long value form the lngIDL to a real path
If SHGetPathFromIDList(lngIDL, strFolder) Then
strFolder = Left(strFolder, InStr(1, strFolder, vbNullChar))
lngReturn = dhcNoError 'to show there is no error.
Else
'nothing real is available.
'return a virtual selection
strFolder = Left(usrBrws.pszDisplayName, InStr(1, usrBrws.pszDisplayName, vbNullChar))
lngReturn = dhcNoError 'to show there is no error.
End If
Else
strFolder = "False"
End If
Else
lngReturn = dhcErrorExtendedError 'something went wrong
End If
BrowseForFolder = lngReturn
End Function
Public Function GetBrowse() As String
Dim strPath As String
'now fill the strPath with the choice by user
Call BrowseForFolder(dhcCSIdlDesktop, dhcBifReturnOnlyFileSystemDirs, _
strPath, pszTitle:="Select a folder:")
GetBrowse = strPath
End Function
Code worked great, except clicking the 'Cancel' button causes a GPF!
(Using Excel 97 on NTSE)
This thread is for discussions of Browse For Folder VBA.