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

You might also like...

Comments

Mike J

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“God could create the world in six days because he didn't have to make it compatible with the previous version.”