Visual Basic for Applications/File and Folder Dialogs

Summary

At times we need to access files and folders to provide input for procedures, and the code below will do this. They are not much different to the dialogs that Windows uses, and each of them works by returning a full path string to the chosen item. When a folder is selected, the returned string does not include the end backslash; the user needs to add that himself.

The two dialogs ''SelectFolder()'' and ''SelectFile()'' will work with both 32 bit and 64 bit version of MS Office, but the API procedure ''BrowseFolder()'' is not intended for 64 bit working; it works only in 32 bit systems. For completeness, another version of the API for 64 bit systems has been added at the foot of the page. Although these two look a bit similar, it is important to choose the right one for your version of MS Office. All three can be run from the test procedure.

Just copy the entire code listing into a standard module for use, and comment out the API version that is unwanted, assuming that an API is used at all.

VBA Code Module

The default file-type listing that opens in SelectFile() is decided by which of the Filters.Add code lines appears first in the sequence. For example, to have the All Files as your prefered listing, just move that line so that it immediately follows the Filters Clear line. Of course, the listing can also be changed by selecting the drop menu while the dialog is open.

Option Explicit
Option Private Module
Option Compare Text
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'This API procedure is for 32 bit systems only; see below for a 64 bit API
    ' API version code credit to Chip Pearson at http://www.cpearson.com/excel/browsefolder.aspx
    ' This contains the BrowseFolder function, which displays the standard Windows Browse For Folder
    ' dialog. It returns the complete path of the selected folder or vbNullString if the user cancelled.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Private Const BIF_RETURNONLYFSDIRS As Long = &H1
    Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
    Private Const BIF_RETURNFSANCESTORS As Long = &H8
    Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
    Private Const BIF_BROWSEFORPRINTER As Long = &H2000
    Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
    
    
    Private Type BROWSEINFO
        hOwner As Long
        pidlRoot As Long
        pszDisplayName As String
        lpszINSTRUCTIONS As String
        ulFlags As Long
        lpfn As Long
        lParam As Long
        iImage As Long
    End Type
    
    
    Private Declare Function SHGetPathFromIDListA Lib "shell32.dll" (ByVal pidl As Long, _
        ByVal pszBuffer As String) As Long
    
    Private Declare Function SHBrowseForFolderA Lib "shell32.dll" (lpBrowseInfo As _
        BROWSEINFO) As Long
    
    
    Private Const MAX_PATH = 260 ' Windows mandated

Sub TestBrowseFilesAndFolders()
    
    Dim sRet As String
    
    'run to test the file selection dialog
    sRet = SelectFile("Select a file...")
    
    'run to test the folder selection dialog
    'sRet = SelectFolder("Select a folder...")
    
    'run to test the API folder selection dialog
    'sRet = BrowseFolder("Select a folder...")
    
    MsgBox sRet

End Sub

Function BrowseFolder(Optional ByVal DialogTitle As String = "") As String
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' BrowseFolder
    ' This displays the standard Windows Browse Folder dialog. It returns
    ' the complete path name of the selected folder or vbNullString if the
    ' user cancelled.   Returns without and end backslash.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    If DialogTitle = vbNullString Then
        DialogTitle = "Select A Folder..."
    End If
    
    Dim uBrowseInfo As BROWSEINFO
    Dim szBuffer As String
    Dim lID As Long
    Dim lRet As Long
    
    
    With uBrowseInfo
        .hOwner = 0
        .pidlRoot = 0
        .pszDisplayName = String$(MAX_PATH, vbNullChar)
        .lpszINSTRUCTIONS = DialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS ' + BIF_USENEWUI
        .lpfn = 0
    End With
    szBuffer = String$(MAX_PATH, vbNullChar)
    lID = SHBrowseForFolderA(uBrowseInfo)
    
    If lID Then
        ''' Retrieve the path string.
        lRet = SHGetPathFromIDListA(lID, szBuffer)
        If lRet Then
            BrowseFolder = Left$(szBuffer, InStr(szBuffer, vbNullChar) - 1)
        End If
    End If

End Function

Function SelectFolder(Optional sTitle As String = "") As String
    'opens a file-select dialog and on selection
    'returns its full path string in the function name
    'If Cancel or OK without selection, returns empty string
    'Returns path string without an end backslash.
    
    Dim sOut As String
        
    With Application.FileDialog(msoFileDialogFolderPicker)
        'see also msoFileDialogFolderPicker, msoFileDialogOpen, and msoFileDialogSaveAs
        'uses Excel's default opening path but any will do
        'needs the backslash in this case
        .InitialFileName = Application.DefaultFilePath & " \ "
        .Title = sTitle
        .Show
        If .SelectedItems.Count = 0 Then
            'MsgBox "Canceled without selection"
        Else
            sOut = .SelectedItems(1)
            'MsgBox sOut
        End If
    End With

    SelectFolder = sOut

End Function

Function SelectFile(Optional sTitle As String = "") As String
    'opens a file-select dialog and on selection
    'returns its full path string in the function name
    'If Cancel or OK without selection, returns empty string
    
    Dim fd As FileDialog, sPathOnOpen As String, sOut As String
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    'do not include backslash here
    sPathOnOpen = Application.DefaultFilePath
    
    'set the file-types list on the dialog and other properties
    With fd
        .Filters.Clear
        .Filters.Add "Excel workbooks", "*.xlsx;*.xlsm;*.xls;*.xltx;*.xltm;*.xlt;*.xml;*.ods"
        .Filters.Add "Word documents", "*.docx;*.docm;*.dotx;*.dotm;*.doc;*.dot;*.odt"
        .Filters.Add "All Files", "*.*"
        
        .AllowMultiSelect = False
        .InitialFileName = sPathOnOpen
        .Title = sTitle
        .InitialView = msoFileDialogViewList 'msoFileDialogViewSmallIcons
        .Show
        
        If .SelectedItems.Count = 0 Then
            'MsgBox "Canceled without selection"
            Exit Function
        Else
            sOut = .SelectedItems(1)
            'MsgBox sOut
        End If
    End With
    
    SelectFile = sOut

End Function
Option Explicit
Option Compare Text

    Private Type BROWSEINFO
        hOwner As LongPtr
        pidlRoot As LongPtr
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As LongPtr
        lParam As LongPtr
        iImage As Long
    End Type
    
    Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
            (ByVal pidl As LongPtr, ByVal pszPath As String) As Long
            
    Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As LongPtr

Private Const BIF_RETURNONLYFSDIRS = &H1

Sub a_testBrowseFolder2()
    'Tests the 64 bit version of the API BrowsFolder2
    
    Dim sFPath As String

    sFPath = BrowseFolder2("Please select a folder.")

    MsgBox sFPath

End Sub

Public Function BrowseFolder2(Optional sTitle As String = "") As String
    'This version of the BrowsFolder API is for 64 bit systems. For 32 bit systems use one at top of page
    'This function returns a folder path string as selected in the browse dialog, without a trailing backslash.
    'Credit is given to Peter De Baets, from which this procedure was trimmed for 64 bit only.
  
    Dim x As Long, Dlg As BROWSEINFO
    Dim DlgList As LongPtr
    Dim sPath As String, Pos As Integer
    Dim sRet As String
  
    sRet = ""
  
    With Dlg
        '.hOwner = hWndAccessApp 'errors
        .lpszTitle = sTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    DlgList = SHBrowseForFolder(Dlg)
    sPath = Space$(512)
    x = SHGetPathFromIDList(ByVal DlgList, ByVal sPath)
    
    If x Then
        Pos = InStr(sPath, Chr(0))
        sRet = Left$(sPath, Pos - 1)
    Else
        sRet = ""
    End If
        
    BrowseFolder2 = sRet

End Function

External Links

• BrowseFolder  : Chip Pearson's page on the API folder browser.
• FileDialog Properties and Methods: The Microsoft documentation for the FileDialog selection methods. It includes a code panel showing the use of file multi-selection.