Option Explicit
'special folders
Private Const ssfALTSTARTUP = &H1D
Private Const ssfAPPDATA = &H1A
Private Const ssfBITBUCKET = &HA
Private Const ssfCOMMONALTSTARTUP = &H1E
Private Const ssfCOMMONAPPDATA = &H23
Private Const ssfCOMMONDESKTOPDIR = &H19
Private Const ssfCOMMONFAVORITES = &H1F
Private Const ssfCOMMONPROGRAMS = &H17
Private Const ssfCOMMONSTARTMENU = &H16
Private Const ssfCOMMONSTARTUP = &H18
Private Const ssfCONTROLS = &H3
Private Const ssfCOOKIES = &H21
Private Const ssfDESKTOP = &H0
Private Const ssfDESKTOPDIRECTORY = &H10
Private Const ssfDRIVES = &H11
Private Const ssfFAVORITES = &H6
Private Const ssfFONTS = &H14
Private Const ssfHISTORY = &H22
Private Const ssfINTERNETCACHE = &H20
Private Const ssfLOCALAPPDATA = &H1C
Private Const ssfMYPICTURES = &H27
Private Const ssfNETHOOD = &H13
Private Const ssfNETWORK = &H12
Private Const ssfPERSONAL = &H5
Private Const ssfPRINTERS = &H4
Private Const ssfPRINTHOOD = &H1B
Private Const ssfPROFILE = &H28
Private Const ssfPROGRAMFILES = &H26
Private Const ssfPROGRAMS = &H2
Private Const ssfRECENT = &H8
Private Const ssfSENDTO = &H9
Private Const ssfSTARTMENU = &HB
Private Const ssfSTARTUP = &H7
Private Const ssfSYSTEM = &H25
Private Const ssfTEMPLATES = &H15
Private Const ssfWINDOWS = &H24
'constants for Dialog box Options
Private Const BIF_VALIDATE = &H20 ' insist on valid result (or CANCEL)
Private Const BIF_BROWSEINCLUDEURLS = &H80 ' Allow URLs to be displayed or entered. (Requires BIF_USENEWUI)
Private Const BIF_UAHINT = &H100 ' Add a UA hint to the dialog, in place of the edit b= &h. May not be combined with BIF_EDITB= &h
Private Const BIF_BROWSEFORCOMPUTER = &H1000 ' Browsing for Computers.
Private Const BIF_BROWSEFORPRINTER = &H2000 ' Browsing for Printers
Private Const BIF_BROWSEINCLUDEFILES = &H4000 ' Browsing for Everything
Private Const BIF_DONTGOBELOWDOMAIN = &H2 ' For starting the Find Computer
Private Const BIF_EDITBOX = &H10 ' Add an editbox to the dialog
Private Const BIF_NEWDIALOGSTYLE = &H40 ' Use the new dialog layout with the ability to resize
Private Const BIF_NONEWFOLDERBUTTON = &H200 ' Do not add the "New Folder" button to the dialog. Only applicable with BIF_NEWDIALOGSTYLE.
Private Const BIF_NOTRANSLATETARGETS = &H400 ' don't traverse target as shortcut
' Caller needs to call OleInitialize() before using this API
Private Const BIF_RETURNONLYFSDIRS = &H1 ' For finding a folder to start document searching
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_SHAREABLE = &H8000 ' sharable resources displayed (remote shares, requires BIF_USENEWUI)
Private Const BIF_STATUSTEXT = &H4 ' Top of the dialog has 2 lines of text for BROWSEINFO.lpszTitle and one line if
Private Const BIF_USENEWUI = BIF_NEWDIALOGSTYLE Or BIF_EDITBOX
'Returns path to selected folder
' vRootFolder can be one of the special folders
' or a string to the root folder
Function fnShellBrowseForFolderVB(vRootFolder as Variant) As String
Dim fso
Dim objShell
Dim objFolder As Object
Dim iOptions As Long 'see constants in declarations
Set fso = CreateObject("Scripting.FileSystemObject")
iOptions = BIF_DONTGOBELOWDOMAIN Or BIF_RETURNONLYFSDIRS
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(Me.hWnd, _
"Browse for Folders", iOptions, vRootFolder)
If (Not objFolder Is Nothing) Then
'the following only works on local drives
fnShellBrowseForFolderVB = fso.GetAbsolutePathName(objFolder.Title)
End If
Set objFolder = Nothing
Set objShell = Nothing
End Function