Excel vba открыть каталог

Хитрости »

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

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

Часто при работе с файлами и написании кодов начинающие «кодить» в 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])
По сути я часто использую именно его, т.к. это универсальный метод и в нем есть все, что лично мне необходимо: выбрать определенные типы файлов позволяет, возможность запрета выбора нескольких файлов сразу есть.

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

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:
Ниже в статье примера кода с применением всех описанных параметров

.Filters.Add "Excel files", "*.xls*;*.xla*", 1 'добавляем возможность выбора файлов Excel
.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов

.InitialFileName = "С:Temp"

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

For Each x In .SelectedItems
    Workbooks.Open x
Next

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

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) только их меньше доступно для применения:

.InitialFileName = "С:Temp"

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])

Пример вызова диалога выбора папки через 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

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

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

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

Что еще важно знать: сам по себе вызов диалога 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»), а одна из предустановленных констант формата файла. Вот основные константы:

Пример использования констант в диалогах 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
ссылки
статистика

• 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:
Ниже в статье примера кода с применением всех описанных параметров

Here is some more cool knowledge to go with this:

I had a situation where I needed to be able to find folders based on a bit of criteria in the record and then open the folder(s) that were found. While doing work on finding a solution I created a small database that asks for a search starting folder gives a place for 4 pieces of criteria and then allows the user to do criteria matching that opens the 4 (or more) possible folders that match the entered criteria.

Here is the whole code on the form:

Option Compare Database
Option Explicit

Private Sub cmdChooseFolder_Click()

    Dim inputFileDialog As FileDialog
    Dim folderChosenPath As Variant

    If MsgBox("Clear List?", vbYesNo, "Clear List") = vbYes Then DoCmd.RunSQL "DELETE * FROM tblFileList"
    Me.sfrmFolderList.Requery

    Set inputFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

    With inputFileDialog
        .Title = "Select Folder to Start with"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        folderChosenPath = .SelectedItems(1)
    End With

    Me.txtStartPath = folderChosenPath

    Call subListFolders(Me.txtStartPath, 1)

End Sub
Private Sub cmdFindFolderPiece_Click()

    Dim strCriteria As String
    Dim varCriteria As Variant
    Dim varIndex As Variant
    Dim intIndex As Integer

    varCriteria = Array(Nz(Me.txtSerial, "Null"), Nz(Me.txtCustomerOrder, "Null"), Nz(Me.txtAXProject, "Null"), Nz(Me.txtWorkOrder, "Null"))
    intIndex = 0

    For Each varIndex In varCriteria
        strCriteria = varCriteria(intIndex)
        If strCriteria <> "Null" Then
            Call fnFindFoldersWithCriteria(TrailingSlash(Me.txtStartPath), strCriteria, 1)
        End If
        intIndex = intIndex + 1
    Next varIndex

    Set varIndex = Nothing
    Set varCriteria = Nothing
    strCriteria = ""

End Sub
Private Function fnFindFoldersWithCriteria(ByVal strStartPath As String, ByVal strCriteria As String, intCounter As Integer)

    Dim fso As New FileSystemObject
    Dim fldrStartFolder As Folder
    Dim subfldrInStart As Folder
    Dim subfldrInSubFolder As Folder
    Dim subfldrInSubSubFolder As String
    Dim strActionLog As String

    Set fldrStartFolder = fso.GetFolder(strStartPath)

'    Debug.Print "Criteria: " & Replace(strCriteria, " ", "", 1, , vbTextCompare) & " and Folder Name is " & Replace(fldrStartFolder.Name, " ", "", 1, , vbTextCompare) & " and Path is: " & fldrStartFolder.Path

    If fnCompareCriteriaWithFolderName(fldrStartFolder.Name, strCriteria) Then
'        Debug.Print "Found and Opening: " & fldrStartFolder.Name & "Because of: " & strCriteria
        Shell "EXPLORER.EXE" & " " & Chr(34) & fldrStartFolder.Path & Chr(34), vbNormalFocus
    Else
        For Each subfldrInStart In fldrStartFolder.SubFolders

            intCounter = intCounter + 1

            Debug.Print "Criteria: " & Replace(strCriteria, " ", "", 1, , vbTextCompare) & " and Folder Name is " & Replace(subfldrInStart.Name, " ", "", 1, , vbTextCompare) & " and Path is: " & fldrStartFolder.Path

            If fnCompareCriteriaWithFolderName(subfldrInStart.Name, strCriteria) Then
'                Debug.Print "Found and Opening: " & subfldrInStart.Name & "Because of: " & strCriteria
                Shell "EXPLORER.EXE" & " " & Chr(34) & subfldrInStart.Path & Chr(34), vbNormalFocus
            Else
                Call fnFindFoldersWithCriteria(subfldrInStart, strCriteria, intCounter)
            End If
            Me.txtProcessed = intCounter
            Me.txtProcessed.Requery
        Next
    End If

    Set fldrStartFolder = Nothing
    Set subfldrInStart = Nothing
    Set subfldrInSubFolder = Nothing
    Set fso = Nothing

End Function
Private Function fnCompareCriteriaWithFolderName(strFolderName As String, strCriteria As String) As Boolean

    fnCompareCriteriaWithFolderName = False

    fnCompareCriteriaWithFolderName = InStr(1, Replace(strFolderName, " ", "", 1, , vbTextCompare), Replace(strCriteria, " ", "", 1, , vbTextCompare), vbTextCompare) > 0

End Function

Private Sub subListFolders(ByVal strFolders As String, intCounter As Integer)
    Dim dbs As Database
    Dim fso As New FileSystemObject
    Dim fldFolders As Folder
    Dim fldr As Folder
    Dim subfldr As Folder
    Dim sfldFolders As String
    Dim strSQL As String

    Set fldFolders = fso.GetFolder(TrailingSlash(strFolders))
    Set dbs = CurrentDb

    strSQL = "INSERT INTO tblFileList (FilePath, FileName, FolderSize) VALUES (" & Chr(34) & fldFolders.Path & Chr(34) & ", " & Chr(34) & fldFolders.Name & Chr(34) & ", '" & fldFolders.Size & "')"
    dbs.Execute strSQL

    For Each fldr In fldFolders.SubFolders
        intCounter = intCounter + 1
        strSQL = "INSERT INTO tblFileList (FilePath, FileName, FolderSize) VALUES (" & Chr(34) & fldr.Path & Chr(34) & ", " & Chr(34) & fldr.Name & Chr(34) & ", '" & fldr.Size & "')"
        dbs.Execute strSQL
        For Each subfldr In fldr.SubFolders
            intCounter = intCounter + 1
            sfldFolders = subfldr.Path
            Call subListFolders(sfldFolders, intCounter)
            Me.sfrmFolderList.Requery
        Next
        Me.txtListed = intCounter
        Me.txtListed.Requery
    Next

    Set fldFolders = Nothing
    Set fldr = Nothing
    Set subfldr = Nothing
    Set dbs = Nothing

End Sub

Private Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & ""
        End If
    End If
End Function

The form has a subform based on the table, the form has 4 text boxes for the criteria, 2 buttons leading to the click procedures and 1 other text box to store the string for the start folder. There are 2 text boxes that are used to show the number of folders listed and the number processed when searching them for the criteria.

If I had the Rep I would post a picture… :/

I have some other things I wanted to add to this code but haven’t had the chance yet. I want to have a way to store the ones that worked in another table or get the user to mark them as good to store.

I can not claim full credit for all the code, I cobbled some of it together from stuff I found all around, even in other posts on stackoverflow.

I really like the idea of posting questions here and then answering them yourself because as the linked article says, it makes it easy to find the answer for later reference.

When I finish the other parts I want to add I will post the code for that too.