Вывод диалоговых окон выбора файла и папки средствами VBA (выбрать файл или папку) Макросы VBA Excel Обработка файлов Список файлов Работа с файлами

Функции 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 просмотров