VBA File Dialogs

A file dialog is a window that allows a user to manually select a directory or files. The FileDialog class defined in the Office Object Library can be used by certain Office applications to create a file dialog window. In applications where the FileDialog class is not available, Windows API functions can be used to create a file dialog.

FileDialog Class

The FileDialog class can be used to create a file dialog window to select elements of the file system and return a path string. The FileDialog class can be accessed as a property of the Application object in Excel, Word, Access, PowerPoint, and Publisher. The FileDialog class is not available in Outlook, Project, or Visio. The FileDialog class has flexible properties that can be set to configure the file dialog for specific situations. The FileDialog property takes a required argument from the MsoFileDialogType enum to create a specific type of file dialog. The various properties of the FileDialog object can be set to tailor the dialog to a specific use and then the Show method can be called to launch the window:

Member	Description
Execute	Executes a user's action after the Show method is called when an Open or SaveAs dialog box is used.
Show	Shows the file dialog window and returns -1 if the action button is clicked and 0 if cancel is clicked.
AllowMultiSelect	When set to True, multiple files can be selected. Does not work for the folder picker dialog or the save as dialog.
Application	Returns the Application object for the application containing the FileDialog object.
ButtonName	Sets the text on the action button.
Creator	Returns a 32-bit integer representing the application containing the FileDialog object.
DialogType	Returns the MsoFileDialogType representing the type of dialog.
FilterIndex	Sets the starting filter from the Filters collection for when the dialog window opens.
Filters	A FileDialogFilters collection object containing FileDialogFilter objects representing file type filters for the FileDialog object.
InitialFileName	Sets the initial path when the dialog window opens.
InitialView	A MsoFileDialogView representing the initial view type when the dialog window opens.
Item	Returns the text associated with the object.
Parent	Returns the parent object of the FileDialog object.
SelectedItems	A FileDialogSelectedItems collection object containing the selected file paths as strings.
Title	Sets the title text of the dialog window.

Select a Single File

Return the value at the first index of the SelectedItems collection.

Public Sub SelectSingleFile()

    Dim FD As Office.FileDialog
    Set FD = Application.FileDialog(msoFileDialogFilePicker)

    With FD
        .AllowMultiSelect = False
        .ButtonName = "Select File"
        .Filters.Clear
        .Filters.Add "All Files", "*.*"
        .Filters.Add "Excel Files", "*.xl*"
        .FilterIndex = 1
        .InitialFileName = Environ$("USERPROFILE") & "\Desktop\"
        .InitialView = msoFileDialogViewDetails
        .Title = "Select a single file"
        If .Show = -1 Then
            Debug.Print .SelectedItems(1)
        Else
            Debug.Print "No file selected."
        End If
    End With

End Sub

Select Multiple Files

Hold the Ctrl key to select multiple files.

Public Sub SelectMultipleFiles()

    Dim FD As Office.FileDialog
    Set FD = Application.FileDialog(msoFileDialogFilePicker)

    With FD
        .AllowMultiSelect = True
        .ButtonName = "Select File(s)"
        .Filters.Clear
        .Filters.Add "All Files", "*.*"
        .Filters.Add "Excel Files", "*.xl*"
        .FilterIndex = 1
        .InitialFileName = Environ$("USERPROFILE") & "\Desktop\"
        .InitialView = msoFileDialogViewDetails
        .Title = "Select files(s)"
        If .Show = -1 Then
            Dim i As Long
            For i = 1 To .SelectedItems.Count
                Debug.Print .SelectedItems(i)
            Next i
        Else
            Debug.Print "No files selected."
        End If
    End With

End Sub

Select a Folder

Properties that only pertain to selecting files do not apply to the folder picker dialog.

Public Sub SelectFolder()

    Dim FD As Office.FileDialog
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)

    With FD
        .ButtonName = "Select Folder"
        .InitialFileName = Environ$("USERPROFILE") & "\Desktop\"
        .InitialView = msoFileDialogViewDetails
        .Title = "Select a Folder"
        If .Show = -1 Then
            Debug.Print .SelectedItems(1)
        Else
            Debug.Print "No folder selected."
        End If
    End With

End Sub

Open/SaveAs

Call the Execute method after using the Show method to execute the action of the dialog.

Public Sub OpenExcelFiles()

    Dim FD As Office.FileDialog
    Set FD = Application.FileDialog(msoFileDialogOpen)

    With FD
        .AllowMultiSelect = True
        .ButtonName = "Select Excel File"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xl*"
        .FilterIndex = 1
        .InitialFileName = Environ$("USERPROFILE") & "\Desktop\"
        .InitialView = msoFileDialogViewDetails
        .Title = "Select Excel files to open"
        If .Show = -1 Then
            .Execute
        Else
            Debug.Print "No file selected."
        End If
    End With

End Sub

Windows API

The OpenFileNameA function or the GetSaveFileNameA function can be used to open a file dialog window and select a file path. Both functions take the OpenFileName struct as a parameter. If the user selects a file path and click OK the functions will return a nonzero value. If the user cancels or an error occurs the functions will return zero. To get detailed error information when the functions do not work as expected use the CommDlgExtendedError function. Setting the values of the OpenFileName struct members and returning errors from these functions requires detailed implementation so it is best to use wrapper functions to call these functions and hide implementation details from the user.

Option Explicit

Public Sub Example()

    On Error GoTo HandleError

    Dim FileName As String
    FileName = GetOpenFileNameWinAPI()

    Debug.Print FileName

    Exit Sub

HandleError:
    If Err.Number - (vbObjectError + 512) = 2 Then
        Debug.Print "No file selected."
    Else
        Err.Raise _
            Number:=Err.Number, _
            Description:=Err.Description
    End If

End Sub

Option Explicit

#If VBA7 = 1 Then

    Private Type OPENFILENAME
        lStructSize         As Long
        hwndOwner           As LongPtr
        hInstance           As LongPtr
        lpstrFilter         As String
        lpstrCustomFilter   As String
        nMaxCustFilter      As Long
        nFilterIndex        As Long
        lpstrFile           As String
        nMaxFile            As Long
        lpstrFileTitle      As String
        nMaxFileTitle       As Long
        lpstrInitialDir     As String
        lpstrTitle          As String
        flags               As Long
        nFileOffset         As Integer
        nFileExtension      As Integer
        lpstrDefExt         As String
        lCustData           As LongPtr
        lpfnHook            As LongPtr
        lpTemplateName      As String
        '#if (_WIN32_WINNT >= 0x0500)
        pvReserved          As LongPtr
        dwReserved          As Long
        FlagsEx             As Long
        '#endif // (_WIN32_WINNT >= 0x0500)
    End Type

    Private Declare PtrSafe Function GetOpenFileName _
        Lib "comdlg32.dll" _
        Alias "GetOpenFileNameA" ( _
        pOpenfilename As OPENFILENAME) As Long

    Private Declare PtrSafe Function CommDlgExtendedError _
        Lib "comdlg32.dll" () As Long

#Else

    Private Type OPENFILENAME
        lStructSize        As Long
        hwndOwner          As Long
        hInstance          As Long
        lpstrFilter        As String
        lpstrCustomFilter  As String
        nMaxCustFilter     As Long
        nFilterIndex       As Long
        lpstrFile          As String
        nMaxFile           As Long
        lpstrFileTitle     As String
        nMaxFileTitle      As Long
        lpstrInitialDir    As String
        lpstrTitle         As String
        flags              As Long
        nFileOffset        As Integer
        nFileExtension     As Integer
        lpstrDefExt        As String
        lCustData          As Long
        lpfnHook           As Long
        lpTemplateName     As String
    '#if (_WIN32_WINNT >= 0x0500)
        pvReserved         As Long
        dwReserved         As Long
        FlagsEx            As Long
    '#endif // (_WIN32_WINNT >= 0x0500)
    End Type

    Private Declare Function GetOpenFileName _
        Lib "comdlg32.dll" _
        Alias "GetOpenFileNameA" ( _
        pOpenfilename As OPENFILENAME) As Long

    Private Declare Function CommDlgExtendedError _
        Lib "comdlg32.dll" () As Long

#End If

Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000&
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOLONGNAMES = &H40000          '  force no long names for 4.x modules
Private Const OFN_EXPLORER = &H80000             '  new look commdlg
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_LONGNAMES = &H200000           '  force long names for 3.x modules

Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0

Private Const CDERR_DIALOGFAILURE = &HFFFF&

Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_STRUCTSIZE = &H1
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_REGISTERMSGFAIL = &HC

Public Function GetOpenFileNameWinAPI() As String

    Const MAX_BUFFER As Long = 255

    Dim OFN As OPENFILENAME

    With OFN
        '.hwndOwner
        '.hInstance
        .lpstrFilter = "All Files" & vbNullChar & "*.*" & String$(2, vbNullChar)
        '.lpstrCustomFilter
        '.nMaxCustFilter
        .nFilterIndex = 1
        .lpstrFile = String$(MAX_BUFFER - 1, " ") & vbNullChar
        .nMaxFile = Len(.lpstrFile)
        .lpstrFileTitle = String$(MAX_BUFFER - 1, " ") & vbNullChar
        .nMaxFileTitle = Len(.lpstrFileTitle)
        .lpstrInitialDir = "C:\" & vbNullChar
        '.lpstrTitle
        .flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
        '.nFileOffset
        '.nFileExtension
        '.lpstrDefExt
        '.lCustData
        '.lpfnHook
        '.lpTemplateName
        '.pvReserved
        '.dwReserved
        '.FlagsEx
        .lStructSize = LenB(OFN)
    End With

    Dim Result As Long
    Result = GetOpenFileName(OFN)

    If Result <> 0 Then
        GetOpenFileNameWinAPI = Trim$(Replace(OFN.lpstrFile, vbNullChar, " "))
    Else
        Dim CDErr As Long
        CDErr = CommDlgExtendedError()
        Dim UDErr As Long
        Dim ErrMsg As String
        Select Case CDErr
            Case CDERR_DIALOGFAILURE
                UDErr = 1
                ErrMsg = "DIALOG FAILURE"
            Case CDERR_GENERALCODES
                UDErr = 2
                ErrMsg = "GENERAL CODES"
            Case CDERR_STRUCTSIZE
                UDErr = 3
                ErrMsg = "STRUCT SIZE"
            Case CDERR_INITIALIZATION
                UDErr = 4
                ErrMsg = "INITIALIZATION"
            Case CDERR_NOTEMPLATE
                UDErr = 5
                ErrMsg = "NO TEMPLATE"
            Case CDERR_NOHINSTANCE
                UDErr = 6
                ErrMsg = "NO HINSTANCE"
            Case CDERR_LOADSTRFAILURE
                UDErr = 7
                ErrMsg = "LOAD STR FAILURE"
            Case CDERR_FINDRESFAILURE
                UDErr = 8
                ErrMsg = "FIND RES FAILURE"
            Case CDERR_LOADRESFAILURE
                UDErr = 9
                ErrMsg = "LOAD RES FAILURE"
            Case CDERR_LOCKRESFAILURE
                UDErr = 10
                ErrMsg = "LOCK RES FAILURE"
            Case CDERR_MEMALLOCFAILURE
                UDErr = 11
                ErrMsg = "MEM ALLOC FAILURE"
            Case CDERR_MEMLOCKFAILURE
                UDErr = 12
                ErrMsg = "MEM LOCK FAILURE"
            Case CDERR_NOHOOK
                UDErr = 13
                ErrMsg = "NO HOOK"
            Case CDERR_REGISTERMSGFAIL
                UDErr = 14
                ErrMsg = "REGISTER MSG FAIL"
            Case Else
                UDErr = 15
                ErrMsg = "Unknown Error"
        End Select
        Err.Raise _
            Number:=vbObjectError + 512 + UDErr, _
            Description:=ErrMsg
    End If

End Function