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

Игорь, огромное человеческое спасибо!
2 суток мучений - в итоге нашел решение в комментарии #42

С уважением,
Сергей.

Подскажите пожалуйста как использовать эти методы при выборе папок из телефона андроид

Здравствуйте: пробую последний макрос "Sub AttachFile_test()"
Я сделал форму заявки на создание макета и отправки данных отправки на почту, работает. Нужно, чтобы можно было выбрать файл (например .jpg) с компьютера (или по сетевому пути) и чтобы файл выбранный уходил как вложение в письме?

Здравствуйте: пробую последний макрос "Sub AttachFile_test()", выбираю файл, сообщение выходит выбран файл... но как его отправить по почте? Поясняю:
Я сделал форму заявки на создание макета и отправки данных отправки на почту, работает. Нужно, чтобы можно было выбрать файл (например .jpg) с компьютера (или по сетевому пути) и чтобы файл выбранный уходил как вложение в письме?

Добрый день!

Подскажите пожалуйста, как после того, как файл был выбран оставить его открытым?

Спасибо,

Доброго времени.

Не могу решить задачку:

Есть файл. В нем есть несколько листов. Нужно по нажатию кнопки сохранить один конкретный лист (допустим его название "Лист1") в конкретную папку с опереденным названием из ячейки.

Ячейка А1 - "77-09-01"
Ячейка А2 - "Зубные протезы"

Ячейка A3 - "77-09-01 Зубные протезы"

Имя файла при сохранении берем из ячейки А3. Это все просто.
Сложность в том что нужно файл сохраниться с папку с именем "77-09-01 Зубы"
Названия папок по сути всегда разные, и в какую именно папку сохранять по сути определяю эти цифры... Они могут быть 66-05-18, 01-04-54 и тд..
Эти все папки условно лежат в папке D:\Ортодонтия\
То есть
в папке Ортодонтия есть не сколько папок:
66-05-18 Протезы
01-04-54 Пластины
77-09-01 зубы

получается выбор папки должен происходить по поиску значения в ячейке А1.
и потом уже выбор этой папки и сохранение...

Каждый раз при сохранении по сути нужно что бы поиском находит папку что бы ее начало было на значения в ячейке A1, и потому туда ее сохранял...

Спасибо за помощь )

Подскажите, пожалуйста, возможно ли при использовании метода GetFolderPath отображать в открывшемся окне не только папки, но и файлы?

Скажите пожалуйста, что делать при ошибке 424. В Exel ругается на Application.FileDialog(msoFileDialogFolderPicker). Может библиотеку какую подключить и как?

Скажите пожалуйста, что делать при ошибке 438. В Outlook ругается на Application.FileDialog(msoFileDialogFolderPicker). Может библиотеку какую подключить и как?

Везде описывается, как задать параметры окна FileDialog (.Title; .InitialFileName; .InitialView; .Filters.Add; .ButtonName). Но нигде не могу найти как задать параметры поиска в верхнем правом углу окна FileDialog?

Вроде иду по правильному пути, вот что получилось:

Function GetFolderPath(Optional ByVal Title As String = "Выберите папки", _
Optional ByVal InitialPath As String = "c:\") As FileDialogSelectedItems

With ТУТ проблема объект FileDialog не дает выбрать только папки, он их открывает (какой объект для папок?)

.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
If .Show <> -1 Then Exit Function
Set GetFolderPath = .SelectedItems

End With
End Function

Спасибо Вам большое за макрос. Подскажите, как переделать GetFolderPath так, чтобы можно было выбирать несколько папок, что-то вроде GetFilenamesCollection, но для папок. Заранее спасибо.

Замечательные функции, активно пользуюсь.
Огромное СПАСИБО
Подскажите, пожалуйста, как из форм выбора выбирать ярлыки
Возвращает сразу объект, а нужен именно ярлык

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

Конечно мне важно именно пермещение фалов на форму и по сложившейся ситуации на работе - не могу писать отдельные проекты ни в VB ни Delphi ни в остальных.
Но, в общем - большое спасибо (за быстрый ответ)!!!

Добрый день.
Извиняюсь что не совсем по теме, но перерыв интернет не нашел ни одного внятного ответа или примера.
Прошу подсказать по работе с файлами:
1. Есть ли возможность в VBA создать не выбор файлов в диалоговом окне, а выбор файла в элементе управления на форме, который бы отображал содержимое конкретной папки.
2. Возможно ли средствами VBA использовать события Drag&Drop, Drag&Over (у меня они не работают). И как правильно организовать перетаскивание файлов на элемент управления на форме и какой элемент правильней использовать в данном случае.
(элемент InkEdit работает не качественно - не отображает мини-картинку файла exel + выводит картинку, а не ярлык.)
3. Если есть возможность показать пример на эту тему.

заранее, большое спасибо!

Все переменные объявлены: вот более полный вариант кода.
Dim MainFile, InFile, ExFile As String
MainFile = ActiveWindow.Caption
InFile = GetFilePath()
If InFile = "" Then Exit Sub
MsgBox "Âûáðàí ôàéë: " & InFile
Workbooks.OpenDatabase Filename:=InFile _
, CommandText:=Array("Çàäîëæåííîñòü*"), CommandType:=xlCmdTable, _
ImportDataAs:=xlTable

Даже без этой строки происходит ошибка на том же месте, я только что проверила. =(

Добрый день.
Я попробовала ваш код на практике, разобралась в принципе работы, но все равно не могу понять причину ошибки в данной части кода (используется последняя функция в вашей статье):
InFile = GetFilePath()
If InFile = "" Then Exit Sub
MsgBox "Âûáðàí ôàéë: " & InFile
Workbooks.OpenDatabase Filename:=InFile _
, CommandText:=Array("Çàäîëæåííîñòü*"), CommandType:=xlCmdTable, _
ImportDataAs:=xlTable
Ошибка происходит при попытке обработать Workbooks. Согласно Watch, путь к файлу находится корректно, но в filename ничего не прописывается. Не могли бы вы подсказать, в чем тут причина?

Доброго времени суток.
Почему выходит ошибка(... not defined)при попытке выполнения кода.
ИмяФайла = GetFilePath("Выберите файл excel", , "Документы Excel", "*.xls")

Заранее спасибо

Спасибо большое! все теперь работает!) вы меня просто спасли!)

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

Добрый день, подскажите пожалуйста, взяла за основу Ваш код для открытия файла и добавила в него выбор диапазона

Sub ПримерИспользования_GetFilePath()
ИмяФайла = GetFilePath("Выберите файл excel", , "Документы Excel", "*.xls") ' запрашиваем имя файла
If ИмяФайла = "" Then Exit Sub ' выход, если пользователь отказался от выбора файла
Workbooks.Open Filename:=ИмяФайла
Range("A8").Value = ИмяФайла
Windows("Продажи для ЭТ 2013.xlsx").Activate
Worksheets("исх").Range("$A$8:$AH$30000").AutoFilter Field:=1, Criteria1:= _
"01. Алексеевка"
Range("A9:AE5000").Select
Selection.Copy
Windows("БДР Алексеевка13.xlsm").Activate
Range("A11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

возможно ли как то вместо прописи названия файла "Продажи для ЭТ 2013.xlsx" чтобы он вытаскивал ссылку на этот файл из ячейки А8? если заментить его на "ИмяФайла" выдает ошибку 400.

Доброго времени суток!
Задача: Необходимо чтобы был вывод диалогового окна выбора папки, но при этом он запоминал предыдущий выбор папки.

Из ваших двух макросов сделал один, но есть небольшая проблемка. Он запоминает предыдущий выбор, но при последующим открытии макроса, он выходит на уровень выше (т.е. мы первй раз выбрали C:\Новая папка\Новая папка1\Новая папка2, второй раз запуская макрос мы поподаем на C:\Новая папка\Новая папка1 а я хочу чтобы был путь C:\Новая папка\Новая папка1\Новая папка2 . Пожалуйста, не подскажите как решить данную проблему. Спасибо.

Вот мой макрос:

Sub AttachFile_test() ' пример использования
Filename$ = GetFolderPath()
If Filename$ = "" Then Exit Sub
MsgBox "Выбрана папка: " & Filename$
End Sub

Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", _
Optional ByVal InitialPath As String = "c:\")
On Error Resume Next

With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "Выбрать": .Title = Title:
.InitialFileName = GetSetting("GetFolderPath", "folder", InitialPath)
If .Show <> -1 Then Exit Function
GetFolderPath = .SelectedItems(1)
SaveSetting Application.Name, "GetFolderPath", "folder", GetFolderPath
End With
End Function

PS Я только начал знакомиться с VBA.

Здравствуйте Игорь! Воспользовался вашим примером, функция GetFolderPath. Работает прекрасно. А как сделать, чтобы открывалось не окно Виндовс, а результат прописывался на лист Эксель?

Доброго времени суток!

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

Заранее благодарен.

Добрый день! целый день голову ломал, так и не получилось, еще небольшая просьба, необходимо к этому макросу добавить chekbox "Не отображать диалоговое окно выбора папки(искать файлы в ранее выбранной папке)", т.е. чтобы можно было ставить галочку и не выводить каждый раз окно выбора файла, а данные считывались с предыдущего выбранного файла. Заранее спасибо! Вот мой макрос:

все получилось, огромное спасибо!

Добрый день! помогите устранить маленькую проблему.
Проблема: в макросе после открытия выбранного файла средствами GetFilePath приходится каждый раз выбранный файл автоматически открывать функцией Workbooks.Open Filename:=ИмяФайла чтобы скопировать несколько ячеек поочередно. Пытался после одного открытия файла просто активировать в дальнейшем функцией Windows(ИмяФайла).Activate указанный файл при открытии. Выкладываю часть макроса, заранее Спасибо!
....
Sub Загрузка_данных()
ИмяФайла = GetFilePath("Выберите файл Excel", "s:\Данные для передачи\", "*.xls")
If ИмяФайла = "" Then Exit Sub
Application.ScreenUpdating = False
Set ActiveWB = ActiveWorkbook
Windows(ActiveWB.Name).Activate
Workbooks.Open Filename:=ИмяФайла 'открываю выбранный файл в первый раз
Range("P6:P36").Select
Selection.Copy
Windows(ActiveWB.Name).Activate
Range("K46").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
Workbooks.Open Filename:=ИмяФайла 'вот здесь не хочу заново открывать этот файл, т.к. он уже ранее открыт. а просто его активировать windows().activate как?????
Range("Q6:Q36").Select
Application.CutCopyMode = False
Selection.Copy
Windows(ActiveWB.Name).Activate
Range("K48").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
....
ActiveWindow.Close
Range("AA46").Select
Application.ScreenUpdating = True
End Sub

Огромное Вам СПАСИБО!!!

Как правильно записать макрос для выбора файла и последующей работы с ним? Вопрос в том, что бы можно было выбрать любой файл, а не тот что прописан в макросе (все файлы будут текстовые):

Sub LOADFILE()
    With ActiveSheet.QueryTables.Add(Connection:= "TEXT;G:\Старое\РАБОТА\zv_seg_o.txt", Destination:=Range("$A$8"))
        .Name = "zv_seg_o"
        ' здесь много строк кода
        .Refresh BackgroundQuery:=False
    End With
End Sub

Здравствуйте. Вопрос по " GetFilePath". Как можно задать в фильтре вместо "*.*", чтобы можно было выбирать только "01.txt", "02.txt", "03.txt", т.е. не все *.txt файлы, а именно перечислить?
И еще... опечаточка на сайте имеется :) ("Функция GetFilenamesCollection позволяет выб!О!рать сразу несколько файлов в одной папке"
Спасибо.

У меня, к счастью (именно, к счастью), тоже нет мака.

Написал небольшую примитивную базку (сам не программист, просто немного умею и быстро учусь при необходимости).

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

Может из-за того, что там стартовая папка указана "C:\"?

По самому коду есть нарекания, явные ошибки?

Существуют ли альтернативные команды создания директорий и вывода диалоговых окон?

Спасибо!

Доброго времени!

Интересует вопрос, как этот код оптимизировать под Office for mac?

Кнопка открывает диалоговое окно, в нём выбирается нужный файл, при нажатии "открыть", по предустановленному шаблону создаётся папка, в неё копируется выбранный файл, диалоговое окно закрывается. Этот код работает на Windows.

Private Sub Photoprot_bef_oper_but_Click()

File_Path = GetFilePath

St = ActiveWorkbook.Path

SrcFile = File_Path
DestFile = St & "\" & "MRI_CT_Rtg" & "\" & Name_.Text & "_" & Date_hospit.Text & "\" & "6. Фото-видеопротокол" & "_" & Photoprot_bef_oper.Text & "\"

On Error Resume Next

MkDir (St & "\" & "MRI_CT_Rtg" & "\")
MkDir (St & "\" & "MRI_CT_Rtg" & "\" & Name_.Text & "_" & Date_hospit.Text & "\")
MkDir (St & "\" & "MRI_CT_Rtg" & "\" & Name_.Text & "_" & Date_hospit.Text & "\" & "6. Фото-видеопротокол" & "_" & Photoprot_bef_oper.Text)

Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile SrcFile, DestFile

End Sub

Function GetFilePath(Optional ByVal Title As String = "Выберите файл для загрузки", _
Optional ByVal InitialPath As String = "C:\") As String

On Error Resume Next

With Application.FileDialog(msoFileDialogOpen)

.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
If .Show <> -1 Then Exit Function
GetFilePath = .SelectedItems(1): PS = Application.PathSeparator

End With

End Function

Необходимо, что бы работало как на винде, так и на мак.

Спасибо!

Сам на свой вопрос ответил )

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim NameRateFile As String
    Dim AskMsg, StyleAskMsg, TitleAskMsg, HelpAskMsg, CtxtAskMsg, ResponseAskMsg, MyStringAskMsg
    Dim AskMsg1, StyleAskMsg1, TitleAskMsg1, HelpAskMsg1, CtxtAskMsg1, ResponseAskMsg1, MyStringAskMsg1
 
    Dim NewFileName As String
    Dim fso As FileSystemObject
    Dim f1, f2 As File
     If Target.Cells.Count > 1 Then Exit Sub
     If Not Application.Intersect(Range("C9:C10"), Target) Is Nothing Then
         UserForm1.Show
     End If
     If Not Application.Intersect(Range("C17:C17"), Target) Is Nothing Then
        'MsgBox "Âûäåëåíà ÿ÷åéêà: "
         NameRateFile = GetFileName("Çàãîëîâîê îêíà", ThisWorkbook.Path)   ' çàïðàøèâàåì èìÿ ôàéëà
        If NameRateFile = "" Then
            NewFileName = ActiveSheet.Name
            Range("C17:C18") = ""
            AskMsg = "Ñîçäàòü ôàéë " + NewFileName + " â òåêóùåé äèðåêòîðèè ?"    ' Define message.
            StyleAskMsg = vbYesNo + vbQuestion + vbDefaultButton2    ' Define buttons
            TitleAskMsg = "Ôàéë íå íàéäå"    ' Define title.
            HelpAskMsg = "DEMO.HLP"    ' Define Help file.
            CtxtAskMsg = 1000    ' Define topic
            ResponseAskMsg = MsgBox(AskMsg, StyleAskMsg, TitleAskMsg, HelpAskMsg, CtxtAskMsg)
 
            AskMsg1 = "Ïåðåçàïèñàòü ñóùåñòâóþùèé ôàéë " + NewFileName + " â òåêóùåé äèðåêòîðèè ?"    ' Define message.
            StyleAskMsg1 = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons
            TitleAskMsg1 = "ÏÅÐÅÇÀÏÈÑÜ ÔÀÉËÀ"    ' Define title.
            HelpAskMsg1 = "DEMO.HLP"    ' Define Help file.
            CtxtAskMsg1 = 1000    ' Define topic
            
            If ResponseAskMsg = vbYes Then    ' User chose Yes.
                Set fso = CreateObject("Scripting.FileSystemObject")
                On Error Resume Next: ResponseAskMsg1 = MsgBox(AskMsg1, StyleAskMsg1, TitleAskMsg1, HelpAskMsg1, CtxtAskMsg1)
                If ResponseAskMsg1 = vbYes Then
                    Set f2 = fso.CreateTextFile(NewFileName + ".txt", True)
                End If
                If ResponseAskMsg1 = vbNo Then
                    MsgBox "Ôàéë íå âûáðàí è íå ñîçäàí !"
                    Exit Sub
                End If
 
                Set f1 = fso.CreateTextFile(NewFileName + ".txt", False)
                f1.Close
                NameRateFile = ThisWorkbook.Path + "\" + NewFileName + ".txt"
            Else    ' User chose No.
                MsgBox "Ôàéë íå âûáðàí è íå ñîçäàí !"
                Exit Sub
            End If
        End If ' âûõîä, åñëè ïîëüçîâàòåëü îòêàçàëñÿ îò âûáîðà ôàéëà
    MsgBox "Âûáðàí ôàéë: " & NameRateFile, vbInformation
    Range("C17:C17") = NameRateFile
    End If
End Sub