Vba word application filedialog

title keywords f1_keywords ms.prod api_name ms.assetid ms.date ms.localizationpriority

Application.FileDialog property (Word)

vbawd10.chm158335426

vbawd10.chm158335426

word

Word.Application.FileDialog

ef478a81-db1d-4bf4-a146-3ff7dd84116b

06/08/2017

medium

Application.FileDialog property (Word)

Returns a FileDialog object which represents a single instance of a file dialog box.

Syntax

expression. FileDialog( _FileDialogType_ )

expression Required. A variable that represents an Application object.

Parameters

Name Required/Optional Data type Description
FileDialogType Required MsoFileDialogType The type of dialog.

Example

This example displays the Save As dialog box.

Sub ShowSaveAsDialog() 
 Dim dlgSaveAs As FileDialog 
 Set dlgSaveAs = Application.FileDialog( _ 
 FileDialogType:=msoFileDialogSaveAs) 
 dlgSaveAs.Show 
End Sub

This example displays the Open dialog box and allows a user to select multiple files to open.

Sub ShowFileDialog() 
 Dim dlgOpen As FileDialog 
 Set dlgOpen = Application.FileDialog( _ 
 FileDialogType:=msoFileDialogOpen) 
 With dlgOpen 
 .AllowMultiSelect = True 
 .Show 
 End With 
End Sub

See also

Application Object

[!includeSupport and feedback]

application filedialog featured

Often in VBA we need to ask the users to select files or directories before we execute the actual functionality of our macro. Welcome to the VBA Open file dialog post. Today we will learn how to use the Application.FileDialog, to understand the various msoFileDialogFilePicker file dialog picking options and how to properly manage these dialogs.

Here is a simple example of a VBA File Dialog:

Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

'Show the dialog. -1 means success!
If fDialog.Show = -1 Then
   Debug.Print fDialog.SelectedItems(1) 'The full path to the file selected by the user
End If

Application FileDialog function

Before we start let’s understand the Application.FileDialog function.

The Application.FileDialog has the following syntax:

Application.FileDialog( fileDialogType as MsoFileDialogType )

Parameter

MsoFileDialogType
An enumeration defining the type of file dialog to open. It has the following values:

Value Description
msoFileDialogOpen Open dialog box
msoFileDialogSaveAs Save As dialog box
msoFileDialogFilePicker File picker dialog box
msoFileDialogFolderPicker Folder picker dialog box

Properties and functions

FileDialog properties

Property Description
AllowMultiSelect Allow to select more than one file or folder
ButtonName Text displayed on the action button of a file dialog box
DialogType Change the MsoFileDialogType (see above)
Filter Set a file filter to filter file types user can select
InitialFileName The initial path to be opened e.g. C:
InitialView The initial file view. Can be one of the following:

  • msoFileDialogViewDetails
  • msoFileDialogViewLargeIcons
  • msoFileDialogViewList
  • msoFileDialogViewPreview
  • msoFileDialogViewProperties
  • msoFileDialogViewSmallIcons
  • msoFileDialogViewThumbnail
  • msoFileDialogViewWebView
SelectedItems Collection of type FileDialogSelectedItems with all selected items
Title Title of the Open file dialog window

Select files – msoFileDialogFilePicker

select file filedialogThe msoFileDialogFilePicker dialog type allows you to select one or more files.

Select single files

The most common select file scenario is asking the user to select a single file. The code below does just that:

Dim fDialog As FileDialog, result As Integer
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    
'Optional: FileDialog properties
fDialog.AllowMultiSelect = False
fDialog.title = "Select a file"
fDialog.InitialFileName = "C:"
'Optional: Add filters
fDialog.Filters.Clear
fDialog.Filters.Add "Excel files", "*.xlsx"
fDialog.Filters.Add "All files", "*.*"

'Show the dialog. -1 means success!
If fDialog.Show = -1 Then
   Debug.Print fDialog.SelectedItems(1)
End If

'Result: C:somefile.xlsx

Select multiple files

Quite common is a scenario when you are asking the user to select one or more files. The code below does just that. Notice that you need to set AllowMultiSelect to True.

Dim fDialog As FileDialog, result As Integer
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    
'IMPORTANT!
fDialog.AllowMultiSelect = True

'Optional FileDialog properties
fDialog.title = "Select a file"
fDialog.InitialFileName = "C:"
'Optional: Add filters
fDialog.Filters.Clear
fDialog.Filters.Add "Excel files", "*.xlsx"
fDialog.Filters.Add "All files", "*.*"

'Show the dialog. -1 means success!
If fDialog.Show = -1 Then
  For Each it In fDialog.SelectedItems
    Debug.Print it
  Next it
End If

'Results:
'C:somefile.xlsx
'C:somefile1.xlsx
'C:somefile2.xlsx

Select folder – msoFileDialogFilePicker

select folder application.filedialogSelecting a folder is more simple than selecting files. However only a single folder can be select within a single dialog window.

Select folder example

The dialog below will ask the user to select a folder:

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker) 'Important we use msoFileDialogFolderPicker instead of (...)FilePicker

'Optional: Properties
fDialog.title = "Select a folder"
fDialog.InitialFileName = "C:"

If fDialog.Show = -1 Then
  Debug.Print fDialog.SelectedItems(1)
End If

The msoFileDialogFolderPicker dialog allows you to only select a SINGLE folder and obviously does not support file folders

Open file – msoFileDialogOpen

file open application.filedialogOpening files is much more simple as it usually involves a single file. The only difference between the behavior between Selecting and Opening files are button labels.

Open file example

The dialog below will ask the user to select a file to open:

Dim fDialog As FileDialog, result As Integer, it As Variant
Set fDialog = Application.FileDialog(msoFileDialogOpen)
    
'Optional: FileDialog properties
fDialog.title = "Select a file"
fDialog.InitialFileName = "C:"
    
'Optional: Add filters
fDialog.Filters.Clear
fDialog.Filters.Add "All files", "*.*"
fDialog.Filters.Add "Excel files", "*.xlsx"
  
If fDialog.Show = -1 Then
  Debug.Print fDialog.SelectedItems(1)
End If

Save file – msoFileDialogSaveAs

saveas application.filedialogSaving a file is similarly easy, and also only the buttons are differently named.

The save file dialog will in fact not save any files! It will just allow the user to select a filename for the file. You need to open the files for reading / writing yourself. Check out my post on how to write files in VBA

Save file example

The dialog below will ask the user to select a path to which a files is to be saved:

Dim fDialog As FileDialog, result As Integer, it As Variant
Set fDialog = Application.FileDialog(msoFileDialogSaveAs)

'Optional: FileDialog properties
fDialog.title = "Save a file"
fDialog.InitialFileName = "C:"

If fDialog.Show = -1 Then
  Debug.Print fDialog.SelectedItems(1)
End If

The msoFileDialogSaveAs dialog does NOT support file filters

FileDialog Filters

One of the common problems with working with the Application.FileDialog is setting multiple file filters. Below some common examples of how to do this properly. To add a filter for multiple files use the semicolor ;:

Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogOpen)
'...
'Optional: Add filters
fDialog.Filters.Clear
fDialog.Filters.Add "All files", "*.*"
fDialog.Filters.Add "Excel files", "*.xlsx;*.xls;*.xlsm"
fDialog.Filters.Add "Text/CSV files", "*.txt;*.csv"
'...

Be sure to clear your list of filters each time. The FileDialog has its nuisances and often filters are not cleared automatically. Hence, when creating multiple dialogs you might see filters coming from previous executed dialogs if not cleared and re-initiated properly.

The open file dialog will in fact not open any files! It will just allow the user to select files to open. You need to open the files for reading / writing yourself. Check out my posts:

  • Read file in VBA
  • Write file in VBA

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

Содержание

  • 1 Displays a dialog box that allows the user to select a directory. The selected directory name (or «Canceled») is then displayed by using the MsgBox function.
  • 2 FileDialogFilters
  • 3 FileDialog with JPG file filter
  • 4 Get selected paths
  • 5 Open File Open Dialog and get the selection (Dialog Types Used with the FileDialog Object)
  • 6 Set the AllowMultiSelect property of the dialog box to allow multiple selections in the dialog box
  • 7 The FileDialog Object
  • 8 User selects path to save HTML files
  • 9 Use the SelectedItems property of the FileDialog object to return the FileDialogSelectedItems collection.
  • 10 You can use the Add method of the FileDialogFilters collection object to create your own list of filter

Displays a dialog box that allows the user to select a directory. The selected directory name (or «Canceled») is then displayed by using the MsgBox function.

   <source lang="vb">

 Sub GetAFolder()
     With Application.FileDialog(msoFileDialogFolderPicker)
       .InitialFileName = Application.DefaultFilePath & ""
       .Title = "Please select a location for the backup"
       .Show
       If .SelectedItems.Count = 0 Then
           MsgBox "Canceled"
       Else
           MsgBox .SelectedItems(1)
       End If
     End With
 End Sub
</source>
   
  

FileDialogFilters

   <source lang="vb">

    Private Sub cmdGetFile_Click()
        Dim fd As FileDialog
        Dim ffs As FileDialogFilters
        Dim vItem
        On Error GoTo Problem
        Set fd = Application.FileDialog(msoFileDialogOpen)
        With fd
            Set ffs = .Filters
            With ffs
              .clear
              .add "Pictures", "*.jpg"
            End With
            .AllowMultiSelect = True
            If .show = False Then Exit Sub
            For Each vItem In .SelectedItems
              Debug.Print vItem
            Next vItem
        End With
        Exit Sub

Problem:

        MsgBox "That was not a valid picture"
    End Sub
</source>
   
  

FileDialog with JPG file filter

   <source lang="vb">

    Private Sub cmdGetFile_Click()
        Dim fd As FileDialog
        Dim ffs As FileDialogFilters
        On Error GoTo Problem
        Set fd = Application.FileDialog(msoFileDialogOpen)
        With fd
            Set ffs = .Filters
            With ffs
              .clear
              .add "Pictures", "*.jpg"
            End With
            .AllowMultiSelect = False
            If .show = False Then Exit Sub
            Image1.Picture = LoadPicture(.SelectedItems(1))
        End With
        Exit Sub

Problem:

        MsgBox "That was not a valid picture"
    End Sub
</source>
   
  

Get selected paths

   <source lang="vb">

Public Sub ShowFileDialog()

   Dim fd As FileDialog
   Dim selectedPaths() As String
   Dim I As Integer
   Set fd = Application.FileDialog(msoFileDialogOpen)
   With fd     "Configure dialog box
       .AllowMultiSelect = True
       .FilterIndex = 2
       .Title = "Select Excel File(s)"
       .InitialFileName = ""
       "Show the dialog and collect file paths selected by the user
       If .Show = -1 Then   "User clicked Open
           ReDim selectedPaths(.SelectedItems.Count - 1)
           "Store file paths for later use.
           For I = 0 To .SelectedItems.Count - 1
               selectedPaths(I) = .SelectedItems(I + 1)
           Next I
       End If
       .Execute     "Open selected files
   End With
   Set fd = Nothing

End Sub

</source>
   
  

Open File Open Dialog and get the selection (Dialog Types Used with the FileDialog Object)

   <source lang="vb">

Dialog Type VBA Constant (FileDialogType)
Open msoFileDialogOpen
Save msoFileDialogSaveAs
File Picker msoFileDialogFilePicker
Folder Picker msoFileDialogFolderPicker
Sub openDlg()

   Dim fc As FileDialogFilters
   Dim ff As FileDialogFilter
   Set fc = Application.FileDialog(msoFileDialogOpen).Filters
   Set ff = fc.Item(1)
   MsgBox ff.Description & ff.Extensions     "Displays "AllFiles" and *.*

End Sub

</source>
   
  

Set the AllowMultiSelect property of the dialog box to allow multiple selections in the dialog box

   <source lang="vb">

Sub OpenDialog()

   Dim dlgOpen As FileDialog
   Set dlgOpen = Application.FileDialog( _
       DialogType:=msoFileDialogOpen)
   With dlgOpen
        .AllowMultiSelect = True
        .Show
   End With
   msgBox dlgOpen.SelectedItems(1)

End Sub

</source>
   
  

The FileDialog Object

   <source lang="vb">

Sub SaveDialog()

   Dim dlgSaveAs As FileDialog
   Set dlgSaveAs = Application.FileDialog(DialogType:=msoFileDialogSaveAs)
   dlgSaveAs.Show
   msgBox dlgSaveAs.SelectedItems(1)

End Sub

</source>
   
  

User selects path to save HTML files

   <source lang="vb">

Private Sub cmdChangePath_Click()

   Dim fd As FileDialog
   Dim I As Integer
   Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   With fd
       .AllowMultiSelect = False "Allow only one selection
       .Title = "Select Folder"
       .InitialFileName = ""
       If .Show = -1 Then
           MsgBox .SelectedItems(1)
       End If
   End With
   Set fd = Nothing

End Sub

</source>
   
  

Use the SelectedItems property of the FileDialog object to return the FileDialogSelectedItems collection.

   <source lang="vb">

Sub selected()

   Dim si As FileDialogSelectedItems
   Set si = Application.FileDialog(msoFileDialogOpen).SelectedItems

End Sub

</source>
   
  

You can use the Add method of the FileDialogFilters collection object to create your own list of filter

   <source lang="vb">

Sub fileDlg()

   Dim fd As FileDialog
   Dim imagePath As String
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   With fd
       .AllowMultiSelect = False
       .Filters.Clear
       .Filters.Add "All files", "*.*"
       .Filters.Add "Image", "*.jpg", 1
       .FilterIndex = 1
       .InitialFileName = ""
       .Title = "Select JPEG file"
       If .Show = -1 Then       "User pressed action button
           imagePath = .SelectedItems(1)
       End If
   End With

End Sub

</source>

Функции GetFileName и GetFilePath по сути аналогичны, и предназначены для вывода диалогового окна выбора файла
(при этом можно указать стартовую папку для поиска файла, и тип/расширение выбираемого файла)

Функция GetFilenamesCollection позволяет выборать сразу несколько файлов в одной папке.

Функция GetFolderPath работает также, только служит для вывода диалогового окна выбора папки.

Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", _
                       Optional ByVal InitialPath As String = "c:") As String
    ' функция выводит диалоговое окно выбора папки с заголовком Title,
    ' начиная обзор диска с папки InitialPath
    ' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора
    Dim PS As String: PS = Application.PathSeparator
    With Application.FileDialog(msoFileDialogFolderPicker)
        If Not Right$(InitialPath, 1) = PS Then InitialPath = InitialPath & PS
        .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
        If .Show <> -1 Then Exit Function
        GetFolderPath = .SelectedItems(1)
        If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS
    End With
End Function
 
Sub ПримерИспользования_GetFolderPath()
    ПутьКПапке = GetFolderPath("Заголовок окна", ThisWorkbook.Path)   ' запрашиваем имя папки
    If ПутьКПапке = "" Then Exit Sub    ' выход, если пользователь отказался от выбора папки
    MsgBox "Выбрана папка: " & ПутьКПапке, vbInformation
End Sub
Function GetFilePath(Optional ByVal Title As String = "Выберите файл для обработки", _
                     Optional ByVal InitialPath As String = "c:", _
                     Optional ByVal FilterDescription As String = "Книги Excel", _
                     Optional ByVal FilterExtention As String = "*.xls*") As String
    ' функция выводит диалоговое окно выбора файла с заголовком Title,
    ' начиная обзор диска с папки InitialPath
    ' возвращает полный путь к выбранному файлу, или пустую строку в случае отказа от выбора
    ' для фильтра можно указать описание и расширение выбираемых файлов
    On Error Resume Next
    With Application.FileDialog(msoFileDialogOpen)
        .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
        .Filters.Clear: .Filters.Add FilterDescription, FilterExtention
        If .Show <> -1 Then Exit Function
        GetFilePath = .SelectedItems(1): PS = Application.PathSeparator
    End With
End Function
 
Sub ПримерИспользования_GetFilePath()
    ИмяФайла = GetFilePath("Выберите файл Word", , "Документы Word", "*.doc") ' запрашиваем имя файла
    If ИмяФайла = "" Then Exit Sub    ' выход, если пользователь отказался от выбора файла
    MsgBox "Выбран файл: " & ИмяФайла, vbInformation
End Sub

Ниже представлены функции для вызова диалоговых окон выбора файлов и папок средствами VBA.

Функции GetFileName и GetFilePath по сути аналогичны, и предназначены для вывода диалогового окна выбора файла
(при этом можно указать стартовую папку для поиска файла, и типрасширение выбираемого файла)

Функция GetFilenamesCollection позволяет выборать сразу несколько файлов в одной папке.

Функция GetFolderPath работает аналогично, только служит для вывода диалогового окна выбора папки.

Function GetFileName(Optional ByVal Title As String = "Выберите файл для обработки", _
                     Optional ByVal InitialPath, _
                     Optional ByVal MyFilter As String = "Книги Excel (*.xls*),") As String
    ' функция выводит диалоговое окно выбора папки с заголовком Title,
    ' начиная обзор диска с папки InitialPath
    ' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора
    If Not IsMissing(InitialPath) Then
        On Error Resume Next: ChDrive Left(InitialPath, 1)
        ChDir InitialPath    ' выбираем стартовую папку
    End If
    res = Application.GetOpenFilename(MyFilter, , Title, "Открыть")  ' вывод диалогового окна
    GetFileName = IIf(VarType(res) = vbBoolean, "", res)    ' пустая строка при отказе от выбора
End Function
 
Sub ПримерИспользования_GetFileName()
    ИмяФайла = GetFileName("Заголовок окна", ThisWorkbook.Path)   ' запрашиваем имя файла
    ' ===================== другие варианты вызова функции =====================
    ' текстовые файлы, стартовая папка не указана
    '       ИмяФайла = GetFileName("Выберите текстовый файл", , "Текстовые файлы (*.txt),")
    ' файлы любого типа из папки "C:Windows"
    '       ИмяФайла = GetFileName(, "C:Windows", "")
    ' ==========================================================================

    If ИмяФайла = "" Then Exit Sub    ' выход, если пользователь отказался от выбора файла
    MsgBox "Выбран файл: " & ИмяФайла, vbInformation
End Sub
Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", _
                       Optional ByVal InitialPath As String = "c:") As String
    ' функция выводит диалоговое окно выбора папки с заголовком Title,
    ' начиная обзор диска с папки InitialPath
    ' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора
    Dim PS As String: PS = Application.PathSeparator
    With Application.FileDialog(msoFileDialogFolderPicker)
        If Not Right$(InitialPath, 1) = PS Then InitialPath = InitialPath & PS
        .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
        If .Show <> -1 Then Exit Function
        GetFolderPath = .SelectedItems(1)
        If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS
    End With
End Function
 
Sub ПримерИспользования_GetFolderPath()
    ПутьКПапке = GetFolderPath("Заголовок окна", ThisWorkbook.Path)   ' запрашиваем имя папки
    ' ===================== другие варианты вызова функции =====================
    ' стартовая папка не указана, заголовок окна по умолчанию
    '       ПутьКПапке = GetFolderPath
    ' обзор папок начинается с папки "Рабочий стол"
    '       СтартоваяПапка = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    '       ПутьКПапке = GetFolderPath("Выберите папку на рабочем столе", СтартоваяПапка)
    ' ==========================================================================

    If ПутьКПапке = "" Then Exit Sub    ' выход, если пользователь отказался от выбора папки
    MsgBox "Выбрана папка: " & ПутьКПапке, vbInformation
End Sub
Function GetFilePath(Optional ByVal Title As String = "Выберите файл для обработки", _
                     Optional ByVal InitialPath As String = "c:", _
                     Optional ByVal FilterDescription As String = "Книги Excel", _
                     Optional ByVal FilterExtention As String = "*.xls*") As String
    ' функция выводит диалоговое окно выбора файла с заголовком Title,
    ' начиная обзор диска с папки InitialPath
    ' возвращает полный путь к выбранному файлу, или пустую строку в случае отказа от выбора
    ' для фильтра можно указать описание и расширение выбираемых файлов
    On Error Resume Next
    With Application.FileDialog(msoFileDialogOpen)
        .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
        .Filters.Clear: .Filters.Add FilterDescription, FilterExtention
        If .Show <> -1 Then Exit Function
        GetFilePath = .SelectedItems(1): PS = Application.PathSeparator
    End With
End Function
 
Sub ПримерИспользования_GetFilePath()
     ИмяФайла = GetFilePath("Выберите файл Word", , "Документы Word", "*.doc") ' запрашиваем имя файла
    ' ===================== другие варианты вызова функции =====================
    ' текстовые файлы, стартовая папка не указана
    '       ИмяФайла = GetFilePath("Выберите текстовый файл", , "Текстовые файлы", "*.txt")
    ' файлы любого типа из папки "C:Windows"
    '       ИмяФайла = GetFilePath(, "C:Windows", , "*")
    ' ==========================================================================

    If ИмяФайла = "" Then Exit Sub    ' выход, если пользователь отказался от выбора файла
    MsgBox "Выбран файл: " & ИмяФайла, vbInformation
End Sub
Function GetFilenamesCollection(Optional ByVal Title As String = "Выберите файлы для обработки", _
                             Optional ByVal InitialPath As String = "c:") As FileDialogSelectedItems
    ' функция выводит диалоговое окно выбора нескольких файлов с заголовком Title,
    ' начиная обзор диска с папки InitialPath
    ' возвращает массив путей к выбранным файлам, или пустую строку в случае отказа от выбора
    With Application.FileDialog(3) ' msoFileDialogFilePicker
        .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
        If .Show <> -1 Then Exit Function
        Set GetFilenamesCollection = .SelectedItems
    End With
End Function
 
Sub ПримерИспользования_GetFilenamesCollection()
    Dim СписокФайлов As FileDialogSelectedItems
    Set СписокФайлов = GetFilenamesCollection("Заголовок окна", ThisWorkbook.Path)   ' выводим окно выбора
    ' ===================== другие варианты вызова функции =====================
    ' стартовая папка не указана, заголовок окна по умолчанию
           Set СписокФайлов = GetFilenamesCollection
    ' обзор файлов начинается с папки "Рабочий стол"
           СтартоваяПапка = CreateObject("WScript.Shell").SpecialFolders("Desktop")
           Set СписокФайлов = GetFilenamesCollection("Выберите файлы на рабочем столе", СтартоваяПапка)
    ' ==========================================================================

    If СписокФайлов Is Nothing Then Exit Sub  ' выход, если пользователь отказался от выбора файлов
    For Each File In СписокФайлов
        Debug.Print File
    Next
End Sub

Ещё один вариант кода (который я использую) для выбора файла
Его отличие — функция запоминает папку, из которой последний раз выбирался файл,
и при повторном запуске диалогового окна выбора файла,
обзор папок будет начат с той папки, откуда последний раз был взят файл.

Sub AttachFile_test()    ' пример использования
    Filename$ = GetFilePath()
    If Filename$ = "" Then Exit Sub
    MsgBox "Выбран файл: " & Filename$
End Sub
 
Function GetFilePath(Optional ByVal Title As String = "Выберите файл для обработки", _
                     Optional ByVal InitialPath As String = "c:", _
                     Optional ByVal FilterDescription As String = "Файлы счетов", _
                     Optional ByVal FilterExtention As String = "*.*") As String
    On Error Resume Next
    With Application.FileDialog(msoFileDialogOpen)
        .ButtonName = "Выбрать": .Title = Title:
        .InitialFileName = GetSetting(Application.Name, "GetFilePath", "folder", InitialPath)
        .Filters.Clear: .Filters.Add FilterDescription, FilterExtention
        If .Show <> -1 Then Exit Function
        GetFilePath = .SelectedItems(1)
        folder$ = Left(.SelectedItems(1), InStrRev(.SelectedItems(1), ""))
        SaveSetting Application.Name, "GetFilePath", "folder", folder$
    End With
End Function
  • 138056 просмотров

Like this post? Please share to your friends:
  • Vba word application commandbars
  • Vba word activedocument words
  • Vba word activedocument close
  • Vba with word 2010
  • Vba with word 2007