Visual Basic for Applications/File and Folder Dialogs

< Visual Basic for Applications

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.

Only one file selection dialog is given, and no significant fault can be found with it. Two folder dialogs are included, one in the same family as the file dialog and the other based on an API. (Credit to Chip Pearson.) These two look a bit different in use, so it is left to the user to choose between them. All three can be run from the test procedure.

Just copy the entire code listing into a standard module for use.

VBA Code Module

Option Explicit
Option Private Module
Option Compare Text
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' 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)
        '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
This article is issued from Wikibooks. The text is licensed under Creative Commons - Attribution - Sharealike. Additional terms may apply for the media files.