VBA Excel. Стандартный диалог выбора файлов Application.GetOpenFilename

Выбор файлов в VBA Excel. Стандартный диалог Application.GetOpenFilename. Стартовая папка диалога выбора файлов.

Содержание

Открытие диалога выбора файлов

Открытие диалога для выбора любого файла и записи его полного имени в ячейку «A1»:

Private Sub CommandButton1_Click()

Range("A1") = Application.GetOpenFilename

End Sub

В процессе выполнения этого кода VBA Excel открывается диалог с заголовком по умолчанию «Открытие файла» и возможностью выбора любого файла. При нажатии на кнопку «Открытие» полное имя выбранного файла запишется в ячейку «A1». При нажатии на кнопку «Отмена» или кнопку закрытия формы в ячейку «A1» запишется строка «Ложь».

Открытие диалога с заголовком «Выбор файла»:

Private Sub CommandButton1_Click()

Range("A1") = Application.GetOpenFilename (, , "Выбор файла")

End Sub

Открытие диалога выбора файлов с указанием одного фильтра:

Private Sub CommandButton1_Click()

Range("A1") = Application.GetOpenFilename ("Файлы Excel 97-2003,*.xls", , "Выбор файла")

End Sub

Фильтр в этом коде VBA Excel представляет из себя пару: наименование фильтра и строка из знака подстановки «*» с расширением отбираемых файлов, разделенных «,». В данном случае в открытом диалоге будут видны файлы с расширением «.xls». Таких пар может быть несколько, как в следующем примере.

Открытие диалога выбора файлов с указанием трех фильтров файлов:

Private Sub CommandButton1_Click()

Range("A1") = Application.GetOpenFilename _

("Файлы Excel 97-2003,*.xls,Текстовые файлы,*.txt,Рисунки,*.jpg", , "Выбор файла")

End Sub

Выбрать один из фильтров можно из раскрывающегося списка диалога выбора файлов «Тип файлов».

Для справки:

Application.GetOpenFilename («Фильтры», номер, «Заголовок диалога»)

Аргумент номер — это номер по порядку фильтра в списке, отображаемого по умолчанию. Если номер отсутствует или превышает количество фильтров, то по умолчанию отображается первый в списке.

Стартовая папка диалога выбора файлов

При открытии стандартного диалога выбора файлов «Application.GetOpenFilename» по умолчанию, как стартовая, выбирается папка «Мои документы» в Windows XP, «Документы» в Windows 8, но, при желании, можно задать, как стартовую, и любую другую папку.

Для этого можно воспользоваться операторами ChDrive (смена текущего диска) и ChDir (смена текущего каталога). По умолчанию текущим является диск «С» в Windows XP, поэтому, если ваша папка находится на этом диске, то ChDrive можно пропустить.

Пример 1
Проверяем, какая папка является стартовой по умолчанию. При вызове процедуры из первого примера диалог откроется именно на этой папке. Если выбрать файл, в ячейку «A1» запишется полный путь к нему, а при отмене выбора, запишется «Ложь».

Private Sub CommandButton1_Click()

Range("A1") = Application.GetOpenFilename

End Sub

Пример 2
В этом примере кода VBA стартовой назначается папка D:\Новая папка. Если пропустить оператор ChDrive "D", то по умолчанию стартовой все-равно останется папка «Мои документы».

Private Sub CommandButton1_Click()

'Смена текущего диска:

ChDrive "D"

'Смена текущего каталога:

ChDir "D:\Новая папка"

Range("A1") = Application.GetOpenFilename

End Sub

Пример 3
Здесь стартовой назначается папка, в которой расположен исходный файл Excel с кодом.

Private Sub CommandButton1_Click()

'Смена текущего диска:

ChDrive Left(ThisWorkbook.Path, 1)

'Смена текущего каталога:

ChDir ThisWorkbook.Path

Range("A1") = Application.GetOpenFilename

End Sub

Имя диска может быть любым, в зависимости от имеющегося на вашем компьютере.

Смотрите, как с помощью VBA Excel можно открыть папку в проводнике Windows для просмотра.

Содержание рубрики VBA Excel по тематическим разделам со ссылками на все статьи.

33 комментария для “VBA Excel. Стандартный диалог выбора файлов Application.GetOpenFilename”

0mega 19.01.2019 в 21:50

есть книга с макросами
Макрос_1
Макрос_2
Макрос_n
в каждом из этих макросов есть одинаковый код (напр Range(«D2:F8»). Clear )

Естественно здесь просится еще один Clear_макрос

и теперь пусть каждый Макрос_n запускает Clear_макрос (Run Clear_макрос )
Какой код надо прописать чтобы машина прервала выполнение Макрос_n, перешла к Clear_макрос, и по окончанию опять вернулась и продолжила работу на Макрос_n ?
т.е. что-то типа Go-Return но на уровне макросов
Евгений 20.01.2019 в 01:41

Ответ в статье: Вызов процедуры Sub из другой подпрограммы VBA
Сергей 11.04.2019 в 11:44

Подскажите, возможно ли, чтобы в диалоговом окне отображался только конкретный (один) файл ?
1. Евгений 11.04.2019 в 14:05
  
  С помощью фильтра это сделать невозможно, но вы можете поместить этот файл в отдельную папку, которую сделать стартовой.
Геннадий 05.12.2019 в 12:35

Добрый день! Спасибо за статью. А как в качестве стартовой папки указать сетевой путь типа «\\Папка1\Папка2»? В данном случае ChDir не срабатывает. Через shell и подключение сетевого диска в пошаговом режиме ChDir работает, а в целом нет.
1. Евгений 05.12.2019 в 14:03
  
  Добрый день, Геннадий!
  В разделе Declarations объявите функцию SetCurrentDirectoryA:
  
  1
  
  Private Declare Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
  
  Далее в программе переопределите путь по умолчанию на сетевой:
  
  1
  2
  3
  4
  
  Sub Test()
  SetCurrentDirectoryA "\\Папка1\Папка2"
  Range("A1") = Application.GetOpenFilename
  End Sub
  
  Геннадий, работоспособность кода я не проверил на сетевых папках из-за их отсутствия. С обычными папками работает. Напишите, что получилось.
2. 1. Юрий 24.09.2021 в 09:55
    
    Евгений, не работает для 64 ОС (((!
  2. 1. Евгений 24.09.2021 в 10:51
      
      Добрый день, Юрий!
      Чтобы функция для Windows32 работала в Windows64, необходимо в нее добавить ключевое слово «PtrSafe»:
      
      1
      
      Private Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
Геннадий 06.12.2019 в 10:19

Спасибо большое, Евгений! То что нужно. Все работает корректно.
Филипп 25.09.2020 в 15:33

Как проверить на нажатие крестика или отмены?

Евгений 25.09.2020 в 23:30

Привет, Филипп!
При закрытии диалога выбора файлов нажатием на крестик или кнопку «Отмена» метод Application.GetOpenFilename возвращает значение False. По возвращенному значению можно отследить нажатие кнопок пользователем:

Private Sub CommandButton1_Click()

Dim x As Variant

x = Application.GetOpenFilename(, , "Выбор файла")

If x = False Then

MsgBox "Нажат крестик или кнопка «Отмена»"

Else

MsgBox "Выбран файл: " & x

End If

End Sub

Леонид 05.11.2020 в 01:27

Здравствуйте, есть ли возможность применить Application.GetOpenFilename с заданием фильтра не только по расширению файла, но и по имени (А*.xls), (B*.xls), (C*.xls) по типу поиска файла в Windows. Если таким образом пытаться ничего не выходит — *.* получается…

Спасибо…

Евгений 05.11.2020 в 09:25

Здравствуйте, Леонид!
Стандартный диалог Application.GetOpenFilename не предусматривает создание фильтров с шаблонами по именам файлов. Частично решить данный вопрос поможет создание нового экземпляра диалогового окна Application.FileDialog с указанием параметра InitialFileName. Частично, потому что здесь можно применить только один шаблон и только в имени файла (не в пути к нему). Но если дать имена файлам с повторяющейся подстрокой, это вполне сработает.

Sub MyFileDialog()

Dim fd As FileDialog, a As String

Set fd = Application.FileDialog(msoFileDialogOpen)

With fd

.InitialFileName = "C:\DATA\Test\*36*.xlsx"

.Show

If .SelectedItems.Count > 0 Then

a = .SelectedItems(1)

MsgBox a

'.Execute

End If

End With

Set fd = Nothing

End Sub

Метод Execute открывает выбранный файл.

Николай 09.04.2021 в 22:16

Евгений, здравствуйте!
Большое спасибо за статью, очень полезный материал.
Подскажите, пожалуйста. Я использую метод Application.GetSaveAsFilename для сохранения данных из массива в текстовой файл. У меня добавлено несколько параметров «FileFilter»:
— Text (Space) (*.txt)
— Text (Tab) (*.txt)
— Text (Comma) (*.csv) и другие.
В зависимости от выбранного типа файлов, должен использоваться определённый разделитель (space, tab, comma и др). Вариант по поиску через расширение (LCase$(Right$(Path, 3))) мне не подходит.
Думаю самый оптимальный вариант это вернуть значение «FilterIndex» выбранного вручную при сохранении, и в зависимости от этого ставить разделитель, но никак не могу получить это значение.

Евгений 10.04.2021 в 17:36

Здравствуйте, Николай!
Попробуйте так:

Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

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

End Type

Private Type OPENFILENAMERESULT

lName As String

nIndex As Integer

End Type

Private Function ShowSave(ByVal strDialogTitle As String, ext As String) As OPENFILENAMERESULT

Dim OFName As OPENFILENAME

Dim strFileSelected

Dim extArray

extArray = Split(ext, ",")

Dim i

i = 0

ext = ""

ext = ext & extArray(i) & Chr$(0) & extArray(i + 1) & Chr$(0)

i = i + 2

Loop While i < UBound(extArray)

With OFName

.lStructSize = LenB(OFName)

.hwndOwner = 0&

.hInstance = 0&

.lpstrFilter = ext & Chr$(0) & Chr$(0)

.lpstrFile = ""

.lpstrDefExt = vbNullString

.nMaxFile = 255

.lpstrFileTitle = Space$(254)

.nMaxFileTitle = 255

.lpstrTitle = strDialogTitle

End With

If GetSaveFileName(OFName) Then

strFileSelected = Trim$(OFName.lpstrFileTitle)

If (InStr(strFileSelected, Chr(0)) > 0) Then

strFileSelected = Left(strFileSelected, InStr(strFileSelected, Chr(0)) - 1)

End If

ShowSave.nIndex = OFName.nFilterIndex - 1

ShowSave.lName = Trim(strFileSelected) & Mid(extArray(ShowSave.nIndex * 2 + 1), 2)

Else

ShowSave.nIndex = 0

ShowSave.lName = ""

End If

End Function

Sub TestDialog()

Dim dialog As OPENFILENAMERESULT

dialog = ShowSave("Save as", "type a (*.txt),*.txt,type b (*.txt),*.txt,type c (*.csv),*.csv")

MsgBox dialog.lName & " " & dialog.nIndex

End Sub

Николай 11.04.2021 в 12:04

Евгений, здравствуйте!
Выдаёт ошибку по первой строке кода (в функции): «The code in this project must be updated for use on 64-bit systems. Please review and update Declare statements and then mark them with the PtrSafe attribute.»
И программно вернуть значение индекса выбранного фильтра “FilterIndex” никак нельзя?
Спасибо)

Евгений 11.04.2021 в 13:19

Добрый день, Николай!
Попробуйте дополнительно указать ключевое слово PtrSafe и изменить тип указателей на LongPtr:

Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As LongPtr

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 Long

lpfnHook As LongPtr

lpTemplateName As String

End Type

Mid 11.05.2021 в 10:59

Здравствуйте. Спасибо за статью!
Интересует, как после выбора файла записать в ячейку его имя без расширения и пути.
Сейчас:

1
2

Path_XML_1 = Application.GetOpenFilename("XML Files (*.XML, *.XML", , "Выберите ПЕРВЫЙ XML")
Cells(1, 1).Value = Path_XML_1

Выводит: D:\TMP\21\Новая папка\Выписка 654.xml
Нужно: Выписка 654.xml

Евгений 11.05.2021 в 13:30

Добрый день!
Уточните, нужно как вы написали: Выписка 654.xml, или без расширения: Выписка 654?

Mid 11.05.2021 в 19:16

Да, простите ,неправильно написал.
Нужно «Выписка 654»

Евгений 11.05.2021 в 19:46

Вырезаем имя файла между последним обратным слешем и точкой:

Dim Path_XML_1 As String, n1 As Long, n2 As Long

Path_XML_1 = Application.GetOpenFilename("XML Files (*.XML, *.XML", , "Выберите ПЕРВЫЙ XML")

n1 = InStrRev(Path_XML_1, "\")

n2 = InStrRev(Path_XML_1, ".")

Cells(1, 1).Value = Mid(Path_XML_1, n1 + 1, n2 - n1 - 1)

1. Mid 12.05.2021 в 07:26
  
  Спасибо!
2. Павел 11.08.2022 в 09:29
  
  Здравствуйте.
  Можете написать полную версию кода?
  И еще. Как сделать, чтобы ссылка на файл появлялась не на листе, а в TextBox с последующей вставкой в определенную ячейку на листе?
3. 1. Евгений 13.08.2022 в 00:03
    
    Здравствуйте, Павел!
    
    Нажатием кнопки CommandButton1 записываем полное имя файла в TextBox1:
    
    1
    2
    3
    
    Private Sub CommandButton1_Click()
    TextBox1.Text = Application.GetOpenFilename(, , "Выбор файла")
    End Sub
    
    Нажатием кнопки CommandButton2 копируем имя файла из TextBox1 в ячейку A1:
    
    1
    2
    3
    
    Private Sub CommandButton2_Click()
    Range("A1") = TextBox1.Text
    End Sub

Александр 20.07.2021 в 18:34

Евгений, большое спасибо за статью!
Хотел уточнить, а есть ли возможность сделать настройку так, чтобы не появлялось диалоговое окно, а файлы были выбраны по умолчанию по определенным признакам? В моем случае, в папке находятся ексель-файлы, и их все нужно выбирать, как-то кажется бессмысленным каждый раз запускать диалоговое окно и выбирать все файлы, но как пропустить данный шаг и настроить автоматический выбор всех ексель-файлов в папке я разобраться не могу.
Буду очень рад, если подскажите какой-нибудь метод. Спасибо!
1. Евгений 21.07.2021 в 01:15
  
  Здравствуйте, Александр!
  Ознакомьтесь со статьей Список файлов в папке. Если в папке содержатся файлы разных форматов, можно в цикле For Each... Next использовать отбор файлов Excel по расширению. А если требуется эти файлы открыть, то это можно сделать прямо из цикла без предварительной записи их полных имен куда-либо.
2. 1. Александр 21.07.2021 в 14:17
    
    Евгений, спасибо.
Махмуд 23.12.2021 в 20:48

Здравствуйте!
Большое спасибо за статью и комментарии.
У меня такой вопрос:
Я сохраняю имя файла из Application.GetOpenFileName в переменную String. Но при каждом обращении к этой переменной открывается диалог открытия файла. Не знаю, как быть?
Мне нужно перенести значения определенных ячеек (не диапазон) из листа открываемой (через Application.GetOpenFileName) книги в определенные ячейки текущей книги.

Евгений 23.12.2021 в 22:24

Здравствуйте, Махмуд!
При обращении к переменной диалог не должен открываться. Вы можете убедиться в этом, запустив мой код:

Private Sub Primer()

Dim str As String

str = Application.GetOpenFilename(, , "Выбор файла")

MsgBox str

Range("A1") = str

str = "Полное имя выбранного файла: " & str

MsgBox str

Range("A2") = str

End Sub

Махмуд 23.12.2021 в 23:02

Спасибо Евгений!
Тут он не открывается. Я согласен!
Но…
Я не знаю как ссылаться на конкретную ячейку выбираемого из диалога файла.
Например,
Dim sFilename As String sFilename = Application.GetOpenFilename Workbooks.Open sFilename
открывает выбираемую книгу. А не нужно, чтобы он открывался. Кстати, Application.UpdateScreen = False тут не поможет.

А прямое присваивание типа
Range("A1") = "= [sFilename]Sheet1!$B$2" при обращении к sFilename заново открывает диалог.

Евгений 23.12.2021 в 23:31

Махмуд, чтобы работать со вновь открытой книгой из кода VBA, ссылку на нее необходимо присвоить объектной переменной:

Private Sub Primer11()

Application.DisplayAlerts = False

Dim sFilename As String, MyWb As Workbook

sFilename = Application.GetOpenFilename

Set MyWb = Workbooks.Open(sFilename)

With MyWb

ThisWorkbook.ActiveSheet.Range("A1") = .Sheets(1).Range("B2")

.Close

End With

Set MyWb = Nothing

Application.DisplayAlerts = True

End Sub

1. Махмуд 24.12.2021 в 00:34
  
  Спасибо еще раз!
  Проблема решена!

алексей б 14.08.2022 в 15:00

Здравствуйте, Евгений.
применяя этот макрос:

Sub закладка()
Dim lngCount As Long
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
        For lngCount = 1 To .SelectedItems.Count
            MsgBox .SelectedItems(lngCount)
        Next lngCount
    End With
....
Workbooks("это.xlsm").Worksheets("вработу").Range("A1").CurrentRegion.Copy
myDoc.Bookmarks("PPP").Range.PasteExcelTable False, False, False
myWord.Visible = True
myWord.Visible = True
Set myWord = Nothing
Set myDoc = Nothing
End Sub

хотел чтобы постоянно не менять в VB путь менять его через диалог выбора файлов. А как открыть файл не знаю.

Обсуждение закрыто.