Папка или файл макрос 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
  • 214477 просмотров

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

Хитрости »

17 Июнь 2015              147497 просмотров


Диалоговое окно выбора файлов/папки

Часто при работе с файлами и написании кодов начинающие «кодить» в VBA сталкиваются с необходимостью предоставить пользователю возможность самостоятельного выбора файлов: либо всех в указанной папке, либо каких-то отдельных. Конечно, можно жестко в коде написать нечто вроде: «C:DocumentsFilesКнига1.xls», но это требует не только наличия именно диска С, но и полной структуры папок и имен файлов. Это очень неудобно в большинстве случаев и куда чаще необходимо дать пользователю возможность самому указать имя файла. Записывать в ячейку листа полный путь и имя весьма непрактично и часто для неискушенного пользователя вызывает только «отторжение» от программы. В статье Просмотреть все файлы в папке я приводил пример кода, который просматривает все файлы в указанной папке и папка при этом выбирается сами пользователем из привычного по работе с Windows диалога. Там используется диалог выбора папок. Именно на этом я и хочу сделать акцент в этой статье — рассказать про некоторые способы вызова подобных диалогов для выбора файлов или папки. Так же обращу внимание на некоторые вещи, которые следует учитывать при использовании того или иного типа диалогов.

  • Диалог выбора файлов Applicaton.GetOpenFileName
  • Диалог выбора файлов FileDialog(msoFileDialogFilePicker)
  • Диалог выбора папки FileDialog(msoFileDialogFolderPicker)
  • Диалог выбора папки через Shell
  • Диалог сохранения файла SaveAs

Если рассматривать наиболее простые варианты, то их два. Выбрать файлы можно через Applicaton.GetOpenFileName или через Application.FileDialog. Отличия в них есть, но я заострю внимание на главном: GetOpenFileName будет работать в любой версии Excel, а класс FileDialog только начиная с Excel 2002, т.к. именно в этой версии впервые был использован класс FileDialog. Это стоит учитывать при разработке.

Диалог выбора файлов Applicaton.GetOpenFileName

Параметры:

Application.GetOpenFilename([FileFilter], [FilterIndex], [Title], [ButtonText], [MultiSelect])
По сути я часто использую именно его, т.к. это универсальный метод и в нем есть все, что лично мне необходимо: выбрать определенные типы файлов позволяет, возможность запрета выбора нескольких файлов сразу есть.

FileFilter Указываются типы файлов, которые будут отображаться в диалоговом окне выбора. Например, если указать «Excel files(*.xls*),*.xls*», то возможно будет выбрать только файлы Excel(с расширением, начинающимся на .xls — .xls, .xlsx, .xlsb, .xlsm и т.д.). Если указать «Text files(*.txt),*.txt», то можно будет выбрать только текстовые файлы с расширением .txt. Так же можно указать более одного типа расширений: «Excel files(*.xls*),*.xls*,Text files(*.txt),*.txt». По умолчанию тип файлов в диалоговом окне будет принадлежать первому указанному типу файлов(*.xls*). Но можно указать любой из перечисленных типов при помощи аргумента FilterIndex. Так же можно указать выбор любых типов файлов: «All files(*.*),*.*»
FilterIndex Если аргументом FileFilter указано более одного типа файлов(расширений), то этот аргумент указывает какой именно тип использовать. Например, следующая строка по умолчанию назначает выбор текстовых типов файлов:

avFiles = Application.GetOpenFilename _
    ("Excel files(*.xls*),*.xls*,Text files(*.txt),*.txt", 2, _
     "Выбрать текстовые или Excel файлы", , True)

Атрибут FilterIndex

Title Текст заголовка диалогового окна. Если указать «Выбрать текстовые или Excel файлы», то именно этот текст будет в заголовке. Если не указывать, то будет текст по умолчанию(нечто вроде «Открытие документа»)
ButtonText Данный аргумент доступен только для ПК под управлением Macintosh(MAC). Назначает текст для кнопки диалогового окна Открыть. Для владельцев Windows этот текст всегда будет «Открыть»
MultiSelect Указывает, может быть выбран только один файл или несколько:

  • True — можно будет выбрать более одного файла для обработки(через Shift или Ctrl или простым выделением мышью внутри окна)
  • False — можно будет выбрать только один файл

По умолчанию принимает значение False
Выбора только одного файла:

avFiles = Application.GetOpenFilename _
    ("Excel files(*.xls*),*.xls*,Text files(*.txt),*.txt", 2, _
     "Выбрать текстовые или Excel файлы", , False)

Выбор нескольких файлов:

avFiles = Application.GetOpenFilename _
    ("Excel files(*.xls*),*.xls*,Text files(*.txt),*.txt", 2, _
     "Выбрать текстовые или Excel файлы", , True)

Пример применения диалога Application.GetOpenFilename

Sub ShowGetOpenDialod()
    Dim avFiles
    'по умолчанию к выбору доступны файлы Excel(xls,xlsx,xlsm,xlsb)
    avFiles = Application.GetOpenFilename _
                ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , False)
    If VarType(avFiles) = vbBoolean Then
        'была нажата кнопка отмены - выход из процедуры
        Exit Sub
    End If
    'avFiles - примет тип String
    MsgBox "Выбран файл: '" & avFiles & "'", vbInformation, "www.excel-vba.ru"
End Sub

В данном случае совершенно неважно указан ли выбор только одного файла или нескольких. Может поменяться только способ обработки полученного результата. Если параметр MultiSelect установлен в False, то переменная avFiles примет тип String, т.е. это будет одна строка. Предположим, что была выбрана книга Excel. Тогда открыть её можно будет как обычно это делается при использовании переменной:

Если же параметр MultiSelect установлен в True, то переменная avFiles примет тип Array — массив строк, в котором будут записаны все пути и имена выбранных файлов. Обрабатывать в таком случае следует циклом:

'avFiles - примет тип Array
    For Each x In avFiles
        Workbooks.Open x
    Next

В приложенном к статье файле приведены две процедуры с использованием этого типа диалога и обработкой файлов с параметром MultiSelect, установленным в True и False.


 
Диалог выбора файлов FileDialog(msoFileDialogFilePicker)

У этого диалога тоже есть параметры и они очень схожи с таковыми в Application.GetOpenFilename:
Ниже в статье примера кода с применением всех описанных параметров

AllowMultiSelect Указывает, может быть выбран только один файл или несколько:

  • True — можно будет выбрать более одного файла для обработки(через Shift или Ctrl или простым выделением мышью внутри окна)
  • False — можно будет выбрать только один файл
Title Текст заголовка диалогового окна. Если указать «Выбрать текстовые или Excel файлы», то именно этот текст будет в заголовке. Если не указывать, то будет текст по умолчанию(нечто вроде «Открытие документа»)
Filters Перечисляются типы файлов, которые будут отображаться в диалоговом окне выбора. Для добавления типа файла(расширения) необходимо использовать метод Add:
.Filters.Add([Description],[Extensions],[Position])

  • Description — описание типа файлов. Произвольный текст, указывающий тип файлов. Например «Рисунки» или «Файлы Excel».
  • Extensions — расширения файлов. Непосредственно перед расширением обязательно должна стоять звездочка и точка: *.xls. Иначе диалог выдаст ошибку. Для перечисления нескольких расширений используется разделитель в виде точки-с-запятой: «*.xls*;*.xla*» или «*.xls;*.xlsx;*.xlsm». Звездочка после расширения заменяет любой набор символов или ни одного. Например, при указании «*.xls*» будет возможным выбрать любые файлы, расширение которых начинается на .xls: .xls,.xlsx,.xlsm,.xlsb и т.д., но нельзя будет выбрать файлы с расширением .xla,.xlam и тем более .doc или .txt. Если необходимо осуществить выбор любого типа файлов, то необходимо просто очистить фильтр и не добавлять никакие типы: .Filters.Clear
  • Position — указывает, каким по счету в списке будет тип файлов. На рисунке ниже первым идет тип «Excel files», а вторым «Text files»:
    Атрибут FilterIndex
  • Тип файлов, который будет показан по умолчанию при вызове диалога определяется свойством FilterIndex диалога FileDialog.
    Важный момент: диалог, вызванный в одном сеансе Excel сохраняет добавленные ранее типы файлов. Поэтому перед назначением новых типов необходимо выполнить очистку фильтра:
    .Filters.Clear

Каждый новый тип файлов добавляется новым Add:

.Filters.Add "Excel files", "*.xls*;*.xla*", 1 'добавляем возможность выбора файлов Excel
.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
FilterIndex Назначает тип файлов, который будет выбран по умолчанию из всех перечисленных в коллекции Filters при вызове диалога
InitialFileName Этим параметром можно задать начальную папку, на которой будет открыт диалог:

.InitialFileName = "С:Temp"

Если при этом еще добавить имя файла, то в поле диалога Имя файла будет так же отображено это имя:

.InitialFileName = "С:TempКнига1.xlsx"

Я лично не рекомендую указывать имя файла, т.к. после показа диалога этот файл автоматически будет выбран, что не всегда бывает правильным. Но все зависит от задач. Если пользователь не выберет самостоятельно ни одного файла, то ответом диалога будет именно файл с указанным именем(Книга1.xlsx). Если такого файла не окажется в папке, то диалог выдаст предупреждение, что такого файла нет.

InitialView Данный параметр определяет внешний вид и структуру окна диалога. Доступно 9 вариантов:

  • msoFileDialogViewDetails
  • msoFileDialogViewLargeIcons
  • msoFileDialogViewList
  • msoFileDialogViewPreview
  • msoFileDialogViewProperties
  • msoFileDialogViewSmallIcons
  • msoFileDialogViewThumbnail
  • msoFileDialogViewTiles
  • msoFileDialogViewWebView

При использовании данного параметра следует учитывать, что на разных операционных системах могут быть доступны не все варианты. Поэтому прежде чем использовать лучше убедиться, что на конечных ПК поддерживается указанный тип. В принципе ничего страшного не произойдет — будет просто показано окно с видом по умолчанию. Но куда правильнее в разработке придерживаться однотипного вида на всех ПК.

SelectedItems Возвращает коллекцию выбранных файлов. В отличии от Application.GetOpenFilename всегда возвращается массив строк, поэтому можно всегда использовать цикл для открытия файлов, даже если параметр AllowMultiSelect установлен в False:

For Each x In .SelectedItems
    Workbooks.Open x
Next

Так же можно отбирать только отдельные файлы по индексам или организовать цикл иначе:

For lf = 1 to .SelectedItems.Count
    x = .SelectedItems(lf)
    Workbooks.Open x
Next

Нумерация строк в SelectedItems всегда начинается с 1

Show Пожалуй, самый важный метод в диалоге — отвечает за показ диалога. При этом метод Show возвращает ответ в виде целого числа:

  • -1 — выбор файлов был сделан и нажата кнопка Открыть
  • 0 — была нажата кнопка отмены

Это можно(точнее нужно!) использовать, чтобы не продолжать выполнение кода, если нажата кнопка Отмены:

If .Show = 0 Then Exit Sub 'была нажата кнопка отмены

Пример вызова диалога выбора файлов:

Sub ShowFileDialog()
    Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Выбрать файлы отчетов" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
        .Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 2 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
        .InitialFileName = "С:TempКнига1.xlsx" 'назначаем папку отображения и имя файла по умолчанию
        .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
        If .Show = 0 Then Exit Sub 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        For lf = 1 To .SelectedItems.Count
            x = .SelectedItems(lf) 'считываем полный путь к файлу
            Workbooks.Open x 'открытие книги
            'можно также без х
            'Workbooks.Open .SelectedItems(lf)
        Next
    End With
End Sub

 
Диалог выбора папки

Диалог выбора папки необходим в случаях, когда файлов в папке много и обработать нужно все эти файлы. Пример такой обработки я уже выкладывал в статье Просмотреть все файлы в папке. Здесь проще всего использовать появившийся в 2002 Excel диалог Application.FileDialog. Его параметры практически такие же, как у Application.FileDialog(msoFileDialogFilePicker) только их меньше доступно для применения:

Title Текст заголовка диалогового окна. Если указать «Выбрать папку с отчетами», то именно этот текст будет в заголовке. Если не указывать, то будет текст по умолчанию(нечто вроде «Открыть папку»)
InitialFileName Этим параметром можно задать начальную папку, на которой будет открыт диалог:

.InitialFileName = "С:Temp"
InitialView Данный параметр определяет внешний вид и структуру окна диалога. Доступно 9 вариантов:

  • msoFileDialogViewDetails
  • msoFileDialogViewLargeIcons
  • msoFileDialogViewList
  • msoFileDialogViewPreview
  • msoFileDialogViewProperties
  • msoFileDialogViewSmallIcons
  • msoFileDialogViewThumbnail
  • msoFileDialogViewTiles
  • msoFileDialogViewWebView

При использовании данного параметра следует учитывать, что на разных операционных системах могут быть доступны не все варианты. Поэтому прежде чем использовать лучше убедиться, что на конечных ПК поддерживается указанный тип. В принципе ничего страшного не произойдет — будет просто показано окно с видом по умолчанию. Но куда правильнее в разработке придерживаться однотипного вида на всех ПК.

SelectedItems Возвращает коллекцию с одним элементом, в котором содержится путь к выбранной папке. Нумерация строк в SelectedItems всегда начинается с 1, но т.к. выбор нескольких папок невозможен, то всегда указывается 1: x = .SelectedItems(1)
ButtonName Назначает текст кнопки, которой подтверждается выбор папки. Может содержать не более 51 знака(чего как правило достаточно).
Show Метод, который вызывает показ диалога с выбранными параметрами. Возвращает ответ в виде целого числа:

  • -1 — папка выбрана и нажата кнопка Открыть
  • 0 — была нажата кнопка отмены

Это можно(точнее нужно!) использовать, чтобы не продолжать выполнение кода, если нажата кнопка Отмены:

If .Show = 0 Then Exit Sub 'была нажата кнопка отмены

Пример вызова диалога выбора папки:

Sub ShowFolderDialog()
    Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выбрать папку с отчетами" '"заголовок окна диалога
        .ButtonName = "Выбрать папку"
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .InitialFileName = "C:Temp" '"назначаем первую папку отображения
        .InitialView = msoFileDialogViewLargeIcons 'вид диалогового окна(доступно 9 вариантов)
        If .Show = 0 Then Exit Sub 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        x = .SelectedItems(1) 'считываем путь к папке
        MsgBox "Выбрана папка: '" & x & "'", vbInformation, "www.excel-vba.ru"
    End With
End Sub

 
Диалог выбора папки через Shell

Диалог Application.FileDialog(msoFileDialogFolderPicker) всем хорош и удобен, кроме одного: как я уже упоминал, он стал доступен из VBA только начиная с 2002 Excel. Плюс, описанные выше диалоги не работают в Outlook — он просто лишен хоть какой-либо реализации выбора папок или файлов. Поэтому дополню статью еще одним вариантом показа диалога выбора папки — с помощью объекта Shell. Этот вариант выбора папки будет работать и в Outlook и в любом другом приложении.

Shell.BrowseForFolder([Hwnd], [sTitle], [iOptions], [vRootFolder])

Hwnd Дескриптор окна, к которому будет относится диалог. Как правило указывается 0
sTitle Поясняющий текст, который будет отображен в диалоге. Подобие заголовка окна. Может быть любым текстом, например «Выбрать папку с отчетами»
iOptions Дополнительные параметры для диалога. Рекомендуется использовать 0. Но можно попробовать и пару других вариантов. Например, если указать 20, то в диалоговом окне появится дополнительное текстовое поле, в котором будет отображено имя выбранной папки.
vRootFolder Аналогично InitialFileName в рассмотренных выше диалогах. Задает начальную папку, на которой диалог будет открыт после запуска.

Диалог выбора папки - Shell
Пример вызова диалога выбора папки через Shell:

Sub GetFolderDialog_Shell()
    On Error Resume Next
    Dim objShellApp As Object, objFolder As Object, ulFlags
    Dim x As String
    Set objShellApp = CreateObject("Shell.Application")
    'ulFlags - числовой код, определяющий вид отображаемого окна и некоторые параметры
    '    ulFlags = 0     - наиболее часто применяемый. Лучше использовать всегда именно 0
    '    ulFlags = 1     - не отображать Корзину
    '    ulFlags = 2     - не включать сетевые папки
    '    ulFlags = 20    - добавляется тестовое поле с отображением имени выбранной папки
    '    ulFlags = 16    - отображать EditBox для ввода полного пути с клавиатуры
    '    ulFlags = 16384 - можно так же выбирать файлы.
    'Некоторые константы можно комбинировать. Например если указать 1 + 16384 - то можно будет выбирать файлы
 
    ulFlags = 0
    Set objFolder = objShellApp.BrowseForFolder(0, "Выбрать папку с отчетами", ulFlags, "C:Temp")'"
    x = objFolder.Self.Path 'записываем в переменную путь к папке
    If Err.Number <> 0 Then
        MsgBox "Папка не выбрана!", vbInformation, "www.excel-vba.ru"
    Else
        MsgBox "Выбрана папка: '" & x & "'", vbInformation, "www.excel-vba.ru"
    End If
End Sub

Конечно, диалог подобный выглядит довольно убого, особенно на современных операционных системах. Но он работает в любых версиях офиса и в любом приложении, в том числе в Outlook. Порой это бывает полезней красоты.

Скачать пример:

  Tips_Macro_GetOpenFileFolder.xls (100,0 KiB, 3 740 скачиваний)


 
Диалог сохранения файла SaveAs

Еще один вид диалогового окна — запрос имени и места сохранения файла.
Параметры:

Application.GetSaveAsFilename([InitialFileName], [FileFilter], [FilterIndex], [Title], [ButtonText])
Универсальный диалог, работающий во всех версиях Excel, начиная с 2000

InitialFileName Можно указать путь и имя файла, которые будут использованы в качестве шаблона для сохранения. По умолчанию в диалоге отображается папка, которая была использована в последний раз в текущем сеансе Excel. Если диалог вызывается впервые, то будет показана для сохранения файлов по умолчанию(задается из самого Excel: Файл(File)Параметры(Options)Сохранение(Save)Расположение локальных файлов по умолчанию(Default local file location)).
Показываем диалог со стартовой папкой на той книге, в которой сам макрос, без указания имени сохраняемой книги:

sToSavePath = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path)

Показываем диалог со стартовой папкой на той книге, в которой сам макрос и именем сохраняемой книги «SaveAs.xlsm»:

sToSavePath = Application.GetSaveAsFilename(InitialFileName:="SaveAs.xlsm", FileFilter:="Excel files (*.xlsm), *.xlsm")

Здесь следует обратить внимание на один важный момент: если необходимо помимо стартовой папки указать еще и имя файла, то в обязательном порядке надо указывать так же аргумент FileFilter. Если его не указывать, то InitialFileName просто откроет указанную папку, т.к. не поймет файлы какого типа надо отображать. Либо вместо «SaveAs.xlsm» надо будет указывать «SaveAs.*», что я лично настоятельно не рекомендую делать.
Несмотря на возможность указать имя файла его можно изменить прямо в диалоговом окне, что тоже порой правильнее. Например, чтобы убедиться в том, что имя файла указано пользователем.

FileFilter Указываются типы файлов, которые будут отображаться в диалоговом окне выбора. Должен совпадать с тем типом, с которым собираемся сохранять файл. Например, если указать «Excel files(*.xls*),*.xls*», то возможно будет выбрать только тип файлов Excel(с расширением, начинающимся на .xls — .xls, .xlsx, .xlsb, .xlsm и т.д.). Если указать «Text files(*.txt),*.txt», то только текстовые файлы с расширением .txt. Так же можно указать более одного типа расширений: «Excel files(*.xls*),*.xls*,Text files(*.txt),*.txt». По умолчанию тип файлов в диалоговом окне будет принадлежать первому указанному типу файлов(*.xls*). Но можно указать любой из перечисленных типов при помощи аргумента FilterIndex. Так же можно указать выбор любых типов файлов: «All files(*.*),*.*»
FilterIndex Если аргументом FileFilter указано более одного типа файлов(расширений), то этот аргумент указывает какой именно тип использовать. Например, следующая строка по умолчанию назначает выбор и сохранение файла в текстовый:

avFiles = Application.GetSaveAsFilename _
    (InitialFileName:=ThisWorkbook.Path, FileFilter:="Excel files(*.xls*),*.xls*,Text files(*.txt),*.txt", FilterIndex:=2)

Атрибут FilterIndex

Title Текст заголовка диалогового окна. Если указать «Выбрать текстовые или Excel файлы», то именно этот текст будет в заголовке. Если не указывать, то будет текст по умолчанию(нечто вроде «Сохранение документа»)
ButtonText Данный аргумент доступен только для ПК под управлением Macintosh(MAC). Назначает текст для кнопки диалогового окна Сохранить. Для владельцев Windows этот текст всегда будет «Сохранить»

Что еще важно знать: сам по себе вызов диалога GetSaveAsFilename ничего не сохраняет — он только создает путь для сохраняемого файла. Сохранять придется принудительно после выбора места и имени.
Пример применения диалога Application.GetSaveAsFilename

Sub ShowGetSaveAsDialod()
    Dim sToSavePath
    sToSavePath = Application.GetSaveAsFilename( _
             InitialFileName:=ThisWorkbook.Path, _
             FileFilter:="Excel files(*.xls*),*.xls*,Text files(*.txt),*.txt", _
             FilterIndex:=2, _
             Title:="Сохранить файл")
    'если нажали Отмена - завершаем процедуру ничего не сохраняя
    If VarType(sToSavePath) = vbBoolean Then
        Exit Sub
    End If
    'непосредственно сохранение файла
    ThisWorkbook.SaveAs Filename:=sToSavePath, FileFormat:=ThisWorkbook.FileFormat
End Sub

Здесь тоже есть нюанс — метод SaveAs имеет два важных аргумента:
1. Filename — путь и имя сохраняемого файла. Здесь должно быть все понятно. Указываем то, что выбрали в диалоге.
2. FileFormat — формат сохраняемого файла. При этом не текстовое представление(как в диалоге «xls» или «txt»), а одна из предустановленных констант формата файла. Вот основные константы:

Константа Excel Числовая константа Расшифровка
xlOpenXMLWorkbookMacroEnabled 51 xlsm — книга Excel
xlOpenXMLWorkbookMacroEnabled 52 xlsm — книга Excel с поддержкой макросов
xlExcel12 50 xlsb — двоичная книга Excel (с поддержкой макросов)
xlOpenXMLAddIn 55 xlam — надстройка Excel
xlOpenXMLTemplate 54 xltx — шаблон Excel
xlOpenXMLTemplateMacroEnabled 53 xltm — шаблон Excel с поддержкой макросов
xlExcel8 56 xls — книга Excel(97 — 2003)
xlAddIn 18 xla — надстройка Excel(97 — 2003)
xlTemplate 17 xlt — шаблон Excel(97 — 2003)
xlCurrentPlatformText -4158 txt — текстовый файл с разделителями табуляции
xlUnicodeText 42 txt — текстовый файл в кодировке Юникод
xlCSV 6 csv — CSV(разделитель запятая)
xlCSVMSDOS 24 csv — CSV(MS — DOS)
XlFileFormat 62 csv — CSV UTF-8(разделитель запятая)
xlTypePDF 0 pdf — файл в формате PDF

Пример использования констант в диалогах Application.GetSaveAsFilename
Сохраняем файл с форматом xlsm — файл с поддержкой макросов. Для этого ищем в таблице выше расширение xlsm и берем либо константу Excel либо числовую константу:

Sub ShowGetSaveAsDialod()
    Dim sToSavePath
    sToSavePath = Application.GetSaveAsFilename( _
             InitialFileName:=ThisWorkbook.Path & "Report.xlsm", _
             FileFilter:="Excel files(*.xlsm),*.xlsm")
    'если нажали Отмена - завершаем процедуру ничего не сохраняя
    If VarType(sToSavePath) = vbBoolean Then
        Exit Sub
    End If
    'непосредственно сохранение файла
    'используем встроенную константу Excel
    ThisWorkbook.SaveAs Filename:=sToSavePath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    'используем числовую константу
    'ThisWorkbook.SaveAs Filename:=sToSavePath, FileFormat:=52
End Sub

Любой метод: либо числовая константа, либо встроенная работают одинаково. Вопрос лишь в том, что лично для Вас будет удобнее и нагляднее.

Так же см.:
Работа с диалогами
Как запретить сообщения?


Статья помогла? Поделись ссылкой с друзьями!

  Плейлист   Видеоуроки


Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

Помогите, пожалуйста.
Как в определенной папке с помощью макроса найти и открыть фаил с названием из ячейки???
Заранее, спасибо большое

 

Johny

Пользователь

Сообщений: 2737
Регистрация: 21.12.2012

А файл какой? Excel?

There is no knowledge that is not power

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

да. в 2003 экселе пытаюсь написать

 

Johny

Пользователь

Сообщений: 2737
Регистрация: 21.12.2012

#4

23.05.2013 11:40:58

Код
Sub f()

    Dim f As String, folder As String, file_name As String

    'Папка для поиска
    folder = "C:Temp"
    
    'Ячейка с именем файла
    file_name = Range("A1")
    
    f = Dir(folder)
    While Not Len(f) = 0
        If f = file_name Then
            Workbooks.Open folder & f
        End If
        f = Dir()
    Wend

End Sub

There is no knowledge that is not power

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

а как сделать, чтобы выбор варианта ответа при появлении диалогового окна был автоматический, или чтобы оно вообще не вылазило???

 

Johny

Пользователь

Сообщений: 2737
Регистрация: 21.12.2012

#7

24.05.2013 14:28:11

Код
Application.DisplayAlerts = False
.....
.....
.....
Application.DisplayAlerts = True

Изменено: Johny24.05.2013 14:28:36

There is no knowledge that is not power

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

а можно ли сделать, чтобы он искал документ в поддиректориях??? :oops:

 

Johny

Пользователь

Сообщений: 2737
Регистрация: 21.12.2012

#9

31.05.2013 17:18:58

Ставим галку: Tools -> References -> Microsoft Scripting Runtime

Код
Private file_name As String
Private f As File, fld As folder

Sub SearchAndOpen()

    Dim source_folder As String
    Dim fso As New FileSystemObject

    'Папка для поиска
    source_folder = "C:TempDir"
    
    'Ячейка с именем файла
    file_name = Range("A1")
    
    Call EnumerateFiles(fso.GetFolder(source_folder))

End Sub

Private Sub EnumerateFiles(root_folder As folder)

    For Each f In root_folder.Files
        If f.Name = file_name Then
            Workbooks.Open f.Path
        End If
    Next
    
    For Each fld In root_folder.SubFolders
        Call EnumerateFiles(fld)
    Next
    
End Sub

Изменено: Johny31.05.2013 17:19:49

There is no knowledge that is not power

 

Hugo

Пользователь

Сообщений: 23253
Регистрация: 22.12.2012

#10

31.05.2013 17:29:09

Я чего-то не понимаю?
Если есть имя файла — то зачем искать? Взяли и открыли. Если ошибка — обработали.
А искать может быть долго — если например файлов тысячи. Да и код с таким поиском больно длинный  — хватает ведь 3-х строк:

Код
Sub f()
    On Error GoTo err_: Workbooks.Open "C:Temp" & Range("A1"): Exit Sub
err_:     MsgBox "Нет такого файла!"
End Sub
 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

Я тоже не понимаю смысла в поиске…

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

Я сам — дурнее всякого примера! …

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

Просто документов очень много. и постоянно открывать файлы под определенными названиями….. смысл тогда составления макроса… Пишу для автоматизации процессов обработки информации, и остановилась на этом моменте.

:oops:

 

Hugo

Пользователь

Сообщений: 23253
Регистрация: 22.12.2012

Если например ситуации такие:
— есть точный список названий файлов
— в определённом месте (папки/подпапки) регулярно генерятся файлы (известна часть имени, или даже не известна)
— нужно открыть все файлы определённой папки/подпапки
— есть какая-то другая система в этих файлах
и открывать такие файлы предстоит регулярно — то есть смысл один раз и надолго облегчить себе работу макросом.
Если же никакой системы нет — то и макросом открывать файлы нет смысла.
Другое дело, что если обработка этих открываемых файлов предстоит макросом — то можно в этот же макрос вписать диалог выбора этих файлов. Т.е. запустили макрос, в диалоге указали сразу все нужные файлы, получили готовый результат.

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

Есть огромный отчет. после обработки макросом, надо, чтобы он брал имя файла из определенной ячейки и открывал фаил с таким именем. информации много, и такой отчет обрабатывается каждый месяц. примерное кол-во файлов на один отчет больше 1000, поэтому, сами понимаете, что открывать каждый, это рутина. таких отчетов за один месяц 30 штук. соответственно, около 30000 существующих файлов…вот как-то так все глобально……

просто открыть, с этим мы разобрались….. но некоторые файлы находятся в поддиректориях, и постоянно происходят какие-то перемещения в этой директории…

 

Hugo

Пользователь

Сообщений: 23253
Регистрация: 22.12.2012

#16

03.06.2013 11:32:43

В теме

http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=25457

есть файл

http://www.planetaexcel.ru/bitrix/components/bitrix/forum.interface/show_file.php?fid=40202&action=download

Там есть такой код:

Код
    For Each aFolder In fso.GetFolder(ThisWorkbook.Path).Files
    
        For Each aFile In aFolder.Files
        
            If fso.GetExtensionName(aFile.Name) Like "xls*" Then
            
                Set wkb = Workbooks.Open(aFile.Path)
                Set wks = wkb.Worksheets(1)
                With wks

и т.д.
Думаю, можно использовать.

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

что-то я не могу разобраться совсем :cry:

 

anvg

Пользователь

Сообщений: 11878
Регистрация: 22.12.2012

Excel 2016, 365

Пробуйте, первый запуск будет долгим. Далее быстрее. Если есть подозрение, что файлы в папке и подпапках изменили положение или имя, то нажать «Обновить». Путь к начальной папке задаётся константой baseFolder в методе InitializeFindю
Успехов.

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

#19

04.06.2013 07:29:04

Код
    Const baseFolder = "d:project"

я так понимаю, здесь надо прописать адрес самой папки, это понятно…
а имя файла он где будет брать???

 

anvg

Пользователь

Сообщений: 11878
Регистрация: 22.12.2012

Excel 2016, 365

#20

04.06.2013 07:50:49

Цитата
а имя файла он где будет брать???

Из активной ячейки (в ней только имя, без расширения)

Изменено: anvg04.06.2013 07:52:42

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

#21

04.06.2013 08:07:46

все, поняла….. все работает…спасибо большое….   :D  и еще один вопрос, если можно….:
как это все сделать так, чтобы он был без этих кнопочек, а в таком виде, чтобы автоматически включался???

до этого было прописано так, но он только с одной папки так открывает….
Заранее огромное спасибо вам!!!!!!!!   :oops:  

Код
Sub ARM()
    Dim f As String, folder As String, file_name As String
    'Папка для поиска
    folder = "C:Documents and SettingsmaksРабочий столДокументы"
    'Ячейка с именем файла
    file_name = LCase(Range("D1")) & ".xls"
    f = Dir(folder)
    While Not Len(f) = 0
        If LCase(f) = file_name Then

            Workbooks.Open folder & f
           
 Application.Run "ARM.XLS!ARM6"
            Exit Sub
        End If
        f = Dir()
    Wend

    Application.Run "ARM.XLS!ARM4"
End Sub

Изменено: lenok04.06.2013 23:58:03

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

#22

04.06.2013 08:24:36

А на кой тут цикл? Если имя файла известно, зачем перебирать все файлы?

Код
Sub ARM()
    Dim folder As String, file_name As String
    'Папка для поиска
    folder = "C:Documents and SettingsmaksРабочий столДокументы"
    'Ячейка с именем файла
    file_name = LCase(Range("D1")) & ".xls"
    If Len(Dir(folder & file_name)) Then
        Workbooks.Open folder & file_name
        Application.Run "ARM.XLS!ARM6"
        Exit Sub
    End If
    Application.Run "ARM.XLS!ARM4"
End Sub

Я сам — дурнее всякого примера! …

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

он не открывает тогда файл в поддиректории :(

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

Ага. А с циклом, следовательно, открывает?

Я сам — дурнее всякого примера! …

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

неа…  тоже не открывает….   :| а надо, чтобы открывал… там мне уже без разницы, есть цикл или нет… надо, чтобы он поддиректории просматривал :?:

 

anvg

Пользователь

Сообщений: 11878
Регистрация: 22.12.2012

Excel 2016, 365

#26

04.06.2013 09:43:56

:?:

Скрытый текст

 

lenok

Пользователь

Сообщений: 39
Регистрация: 23.05.2013

 

Sandero

Пользователь

Сообщений: 14
Регистрация: 27.02.2014

#28

18.06.2019 13:20:28

Цитата
Hugo написал:
Я чего-то не понимаю?Если есть имя файла — то зачем искать? Взяли и открыли. Если ошибка — обработали.А искать может быть долго — если например файлов тысячи. Да и код с таким поиском больно длинный  — хватает ведь 3-х строк

Добрый день!
Попробовал ваш вариант, работает. Я правда добавил ещё запуск другого макроса по созданию файла с этим именем если его нет (т.е. если не выполнено первое условие)
Эксель при отсутствии файла выдаёт своё собственное сообщение
По нажатии «оК» появляется уже месседж из макроса.
М.б. это связано с версией экселя, у меня 2016, а тут код вроде для 2003 изначально, или это не имеет значения.
Можно ли убрать сообщение самого экселя?
Заранее благодарен!!

Код
Sub SearhFiles() 'Макрос поиска файла с именем и автоматическое его открытие при наличии
On Error GoTo err_: Workbooks.Open "\Server777S" & Range("F2") & ".xls": Exit Sub
err_:     MsgBox "Нет такого файла!"
Application.Run "DOC.xlsm!Upload" 'Запуск макроса по созданию файла с именем
End Sub

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

Функция Dir служит для проверки существования каталога или файла, отвечающих заданному образцу.

Функция поддерживает использование подстановочных знаков для нескольких символов (*) и одиночного символа (?) для указания нескольких файлов. Функция возвращает первое имя файла, имя которого соответствует аргументу PathName. Для получения остальных файлов, имена которых соответствуют PathName, следует повторно вызвать функцию Dir без аргументов. Последовательные вызовы функции без аргументов возможны до тех пор, пока имеются файлы или папки, соответствующие образцу первого вызова (с аргументами)
Примечание Рекурсивные вызовы функции Dir запрещены

Синтаксис функции в VBA:

Dir[ (PathName[, Attributes])]

Функция возвращает данные типа String, структурно представляющего имя файла или папки, которые удовлетворяют указанному шаблону имени файла, набору атрибутов файла или метке тома на диске. Если аргумент PathName не найден, то функция Dir возвращает пустую строку (““)
Примечание Если после возврата функцией пустой строки, снова вызвать функцию без аргументов, то возникает ошибка времени исполнения Invalid procedure call or argument

Параметры функции

PathName — Необязательный аргумент. Строковое выражение, указывающее имя файла. Также может содержать имя каталога или папки и диска. При использовании имен файлов или папок, содержащих пробелы следует использовать дополнительные кавычки —Dir (» «C:Русский Проектapp.exe“») или Dir (Chr (34) & «C:Русский Проектapp.exe» & Chr (34))
Примечание Хотя PathName указан, как необязательный аргумент, он обязателен при первом вызове функции, а также в случаях, если задан аргумент Attributes

Attributes — Необязательный аргумент, содержащее константу или числовое выражение, описывающее атрибуты файла. Если этот аргумент опущен, возвращаются все файлы, имена которых удовлетворяют содержимому аргумента PathName.

Допустимые значения Attributes

vbNormal=0 — Обычное состояние файла. Используется по умолчанию

vbReadOnly=1  — Атрибут только для чтения

vbHidden=2 — Скрытый атрибут

vbSystem=4  — Системный атрибут

vbVolume=8 — Метка тома

vbDirectory=16 — Каталог или папка

Примечание Можно также указывать комбинации атрибутов путем их суммирования
Например, vbHidden+vbDirectory выводит скрытые папки

Пример кода на языке программирования VBA (Visual Basic for Applications):

' Примеры использования функции

Dim retval

' При наличии выводит WIN.INI

retval=Dir ( «c:windowswin.ini»)

Print retval

' Возвращает имя файла с расширением txt

' При наличии нескольких файлов возвращается

' первый найденный файл

retval = Dir ( «c:windows*.txt»)

MsgBox retval

Возможно вам это будет интересно!

Понравилась статья? Поделить с друзьями:
  • Папка для форматов файлов word
  • Папка для временных файлов excel
  • Папка для автосохранения word
  • Папка в формате excel
  • Папка в которой microsoft word