Перечень папок в excel

Список файлов в папке

Иногда бывает необходимо заполучить на лист Excel список файлов в заданной папке и ее подпапках. В моей практике такое встречалось неоднократно, например:

• перечислить в приложении к договору на проведение тренинга список файлов из раздаточных материалов для особо щепетильных юристов в некоторых компаниях
• создать список файлов для ТЗ проекта
• сравнить содержимое папок (оригинал и бэкап, например)

Для реализации подобной задачи можно использовать несколько способов.

Способ 1. Скелет из шкафа — функция ФАЙЛЫ

Этот способ использует древнюю функцию ФАЙЛЫ (FILES), оставшуюся в Microsoft Excel с далеких девяностых. Вы не найдете эту функцию в общем списке функций, но для совместимости, она всё ещё остаётся внутри движка Excel, и мы вполне можем её использовать.

Механизм таков:

1. В любую ячейку листа (например, в А1) введём путь к папке, список файлов из которой мы хотим получить.

Обратите внимание, что путь должен оканчиваться шаблоном со звездочками:

• *.* — любые файлы
• *.xlsx — книги Excel (только с расширением xlsx)
• *.xl* — любые файлы Excel
• *отчет* — файлы, содержащие слово отчет в названии

и т.д.

2. Создадим именованный диапазон с помощью вкладки Формулы — далее кнопка Диспетчер имен — Создать (Formulas — Names Manger — Create). В открывшемся окне введем любое имя без пробелов (например Мои_файлы) и в поле диапазона выражение:

=ФАЙЛЫ(Лист1!$A$1)

После нажатия на ОК будет создан именованный диапазон с именем Мои_файлы, где хранится список всех файлов из указанной в А1 папки. Останется их оттуда только извлечь.

3. Чтобы извлечь имена отдельных файлов из созданной переменной, используем функцию ИНДЕКС (INDEX), которая в Excel вытаскивает данные из массива по их номеру:

Если лениво делать отдельный столбец с нумерацией, то можно воспользоваться костылем в виде функции СТРОКИ (ROWS), которая будет подсчитывать количество заполненных строк с начала списка автоматически:

=ИНДЕКС(Мои_файлы; ЧСТРОК($B$3:B3))

Ну, и скрыть ошибки #ССЫЛКА! в конце списка (если вы протягиваете формулу с запасом) можно стандартной функцией ЕСЛИОШИБКА (IFERROR):

=ЕСЛИОШИБКА(ИНДЕКС(Мои_файлы; ЧСТРОК($B$3:B3)); «»)

Важное примечание: формально функция ФАЙЛЫ относится к макро-функциям, поэтому необходимо будет сохранить ваш файл в формате с поддержкой макросов (xlsm или xlsb).

Способ 2. Готовый макрос для ленивых

Если вы знакомы с макросами (не в смысле их программирования, а в смысле копипастинга готовых кодов на VBA), то вам, возможно, отлично зайдёт небольшой макрос, добавляющий в текущую книгу новый пустой лист и выводящий на него список всех файлов с их параметрами из заданной пользователем папки.

Для добавления макроса в вашу книгу нажмите сочетание клавиш Alt+F11, или кнопку Visual Basic на вкладке Разработчик (Developer), в открывшемся окне редактора Visual Basic вставьте новый модуль через меню Insert — Module и скопируйте туда текст этого макроса:

Sub FileList()
    Dim V As String
    Dim BrowseFolder As String
    
    'открываем диалоговое окно выбора папки
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку или диск"
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            MsgBox "Вы ничего не выбрали!"
            Exit Sub
        End If
    End With
    BrowseFolder = CStr(V)
    
    'добавляем лист и выводим на него шапку таблицы
    ActiveWorkbook.Sheets.Add
    With Range("A1:E1")
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range("A1").Value = "Имя файла"
    Range("B1").Value = "Путь"
    Range("C1").Value = "Размер"
    Range("D1").Value = "Дата создания"
    Range("E1").Value = "Дата изменения"
    
    'вызываем процедуру вывода списка файлов
    'измените True на False, если не нужно выводить файлы из вложенных папок
    ListFilesInFolder BrowseFolder, True
End Sub


Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)

    Dim FSO As Object
    Dim SourceFolder As Object
    Dim SubFolder As Object
    Dim FileItem As Object
    Dim r As Long

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.getfolder(SourceFolderName)

    r = Range("A65536").End(xlUp).Row + 1   'находим первую пустую строку
    'выводим данные по файлу
    For Each FileItem In SourceFolder.Files
        Cells(r, 1).Formula = FileItem.Name
        Cells(r, 2).Formula = FileItem.Path
        Cells(r, 3).Formula = FileItem.Size
        Cells(r, 4).Formula = FileItem.DateCreated
        Cells(r, 5).Formula = FileItem.DateLastModified
        r = r + 1
        X = SourceFolder.Path
    Next FileItem
    
    'вызываем процедуру повторно для каждой вложенной папки
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If

    Columns("A:E").AutoFit

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing

End Sub

Для запуска макроса нажмите сочетание клавиш Alt+F8,или кнопку Макросы (Macros) на вкладке Разработчик (Developer), выберите наш макрос FileList и нажмите кнопку Выполнить (Run). В диалоговом окне выберите любую папку или диск и — вуаля!

Если захотите, чтобы вместо пути к файлу в столбце B выводилась живая гиперссылка, то замените 52-ю строку

Cells(r, 2).Formula = FileItem.Path

на

Cells(r, 2).Formula = «=HYPERLINK(«»» & FileItem.Path & «»»)»

Способ 3. Мощь и красота — надстройка Power Query

Power Query — это очень мощная и при этом бесплатная надстройка для Excel от Microsoft, упрощающая множество задач по загрузке и трансформации данных. В нашей ситуации она тоже может здорово помочь.

Если у вас Excel 2016 или новее, то Power Query уже встроена в Excel по умолчанию, поэтому просто на вкладке Данные выберите команду Создать запрос / Получить данные — Из файла — Из папки (Create Query / Get Data — From file — From folder). Если у вас Excel 2010-2013, то Power Query нужно будет скачать с сайта Microsoft и установить как отдельную надстройку и она появится у вас в Excel в виде отдельной вкладки Power Query. На ней будет аналогичная кнопка Из файла — Из папки (From file — From folder).

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

Если внешний вид списка вас устраивает, то можно смело жать внизу кнопку Загрузить (Load), чтобы залить эти данные на новый лист. Если же хочется дополнительно обработать список (удалить лишние столбцы, отобрать только нужные файлы и т.п.), то нужно выбрать команду Изменить / Преобразовать данные (Edit / Transform Data).

Поверх окна Excel откроется окно редактора Power Query, где мы увидим список всех наших файлов в виде таблицы:

Дальше возможны несколько вариантов:

• Если нужны только файлы определенного типа, то их можно легко отобрать с помощью фильтра по столбцу Extension:

  

• Аналогичным образом фильтрами по столбцам Date accessed, Date modified или Date created можно отобрать файлы за нужный период (например, созданные только за последний месяц и т.п.):

  
• Если нужно получить данные не из всех папок, то фильтруем по столбцу Folder Path, чтобы оставить только те строки, где путь содержит/не содержит нужные имена папок:

  

• Там же можно выполнить сортировку файлов по любому столбцу, если требуется.

После того, как необходимые файлы отобраны, можно смело удалить ненужные столбцы, щелкнув по заголовку столбца правой кнопкой мыши и выбрав команду Удалить (Remove column). Это, кстати, уже никак не повлияет на фильтрацию или сортировку нашего списка:

Если в будущем планируется подсчитывать количество файлов в каждой папке (например, для контроля поступивших заявок или подсчета статистики по заявкам), то имеет смысл дополнительно сделать ещё пару действий:

• Щелкните правой кнопкой мыши по столбцу Folder Path и выберите команду Дублировать столбец (Duplicate Column).
• Выделите скопированный столбец и на вкладке Преобразование (Transform) выберите Разделить столбец — По разделителю (Split Column — By delimiter)

Мы получим рядом с нашими данными еще несколько столбцов, где будут продублированы имена вложенных папок — это пригодится нам чуть позже для подсчета статистики с помощью сводной таблицы:

Получившиеся столбцы можно переименовать (Диск, Папка1, Папка2 и т.д.), просто щёлкнув дважды по заголовку каждого.

И, наконец, когда список готов, то его можно выгрузить на лист с помощью команды Главная — Закрыть и загрузить — Закрыть и загрузить в… (Home — Close & Load — Close & Load to…):

Дополнительным бонусом можно сделать еще один столбец с функцией ГИПЕРССЫЛКА (HYPERLINK), которая создаст красивые стрелочки-ссылки для моментального перехода к каждому файлу:

Мелочь, а приятно

И вдвойне приятно, что в будущем, при изменении содержимого исходной папки, достаточно будет просто щелкнуть мышью по нашей таблице и выбрать команду Обновить (Refresh) — и Power Query выполнит всю цепочку запрограммированных нами единожды действий уже автоматически, отобразив все изменения в составе папки.

Ссылки по теме

• Что такое макрос, куда вставлять код макроса на Visual Basic
• Создание резервных копий ценных файлов
• Что такое Power Query и что можно делать с её помощью

Данный макрос позволяет получить список папок, расположенных в выбранной папке (каталоге)

Если надо получить список папок, имена которых удовлетворяют определённому критерию, используйте маску поиска (параметр Mask$)

Код функции и пример использования:

Sub ПоискПодходящихПодпапок()
    ' считываем в колекцию coll подходящие полные пути папок
    ' (поиск папок с названием, начинающимся на 09)
    Set coll = SubFoldersCollection("d:", "09*")
 
    For i = 1 To coll.Count    ' перебираем все элементы коллекции, содержащей пути к папкам
        Debug.Print coll(i) ' выводим очередной путь в окно Immediate
    Next
End Sub

Option Compare Text
 
Function SubFoldersCollection(ByVal FolderPath$, Optional ByVal Mask$ = "*") As Collection
    Set SubFoldersCollection = New Collection    ' создаём пустую коллекцию
    Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
    If Right(FolderPath$, 1) <> "" Then FolderPath$ = FolderPath$ & ""
    On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath$)
    For Each folder In curfold.SubFolders    ' перебираем все подпапки в папке FolderPath
        If folder.Path Like FolderPath$ & Mask$ Then SubFoldersCollection.Add folder.Path & ""
    Next folder
    Set FSO = Nothing
End Function

В этом примере та же функция используется для вывода названий подпапок на лист Excel:

Код немного изменён:

Option Compare Text
 
Sub ЗагрузкаСпискаПодпапок()
    On Error Resume Next
    ' считываем в колекцию coll подходящие полные пути папок
    Set coll = SubFoldersCollection([b1], "*") ' путь к основной папке берем из ячейки B1

    For i = 1 To coll.Count    ' перебираем все элементы коллекции, содержащей пути к папкам
        Cells(i + 2, 1) = coll(i)    ' выводим очередное название папки на лист
    Next
End Sub
 
Sub Очистка()
    On Error Resume Next
    Range([A3], Range("A" & Rows.Count).End(IIf(Len(Range("A" & Rows.Count)), xlDown, xlUp))).ClearContents
End Sub
 
Function SubFoldersCollection(ByVal FolderPath$, Optional ByVal Mask$ = "*") As Collection
    Set SubFoldersCollection = New Collection    ' создаём пустую коллекцию
    Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
    If Right(FolderPath$, 1) <> "" Then FolderPath$ = FolderPath$ & ""
    On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath$)
    For Each folder In curfold.SubFolders    ' перебираем все подпапки в папке FolderPath
        If folder.Path Like FolderPath$ & Mask$ Then SubFoldersCollection.Add folder.Name
    Next folder
    Set FSO = Nothing
End Function

Расширенная версия функции — для поиска подпапок любого уровня вложенности:

Function FoldersCollection(ByVal FolderPath$, Optional ByVal Mask$ = "*", Optional ByVal SearchDeep& = 999) As Collection
    ' Получает в качестве параметра путь к папке FolderPath,
    ' маску имени искомых папок Mask (будут отобраны только папки с подходящим именем)
    ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
    ' Возвращает коллекцию, содержащую полные пути к найденным папкам
    ' (применяется рекурсивный вызов процедуры FindFolders)

    Set FoldersCollection = New Collection        ' создаём пустую коллекцию
    FindFolders FolderPath, Mask, FoldersCollection, SearchDeep        ' поиск
End Function
 
Function FindFolders(ByVal FolderPath$, ByVal Mask$, ByRef coll As Collection, ByVal SearchDeep&)
    ' перебирает все подпапки в папке FolderPath, используя объект FSO
    ' перебор подпапок осуществляется в том случае, если SearchDeep > 1
    ' добавляет пути найденных папок в коллекцию coll

    Static FSO As Object: Dim current_folder As Object, folder As Object, subfolder As Object
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
 
    On Error Resume Next: Set current_folder = FSO.GetFolder(FolderPath)
    If Not current_folder Is Nothing Then        ' если удалось получить доступ к папке

        If current_folder.Name Like Mask Then coll.Add current_folder.Path & ""
        SearchDeep = SearchDeep - 1        ' уменьшаем глубину поиска в подпапках

        For Each folder In current_folder.SubFolders        ' перебираем все подпапки в папке FolderPath
            If folder.Name Like Mask Then coll.Add folder.Path & ""
 
            If SearchDeep Then        ' если надо искать глубже
                For Each subfolder In folder.SubFolders        ' перебираем все подпапки в очередной папке
                    FindFolders subfolder.Path, Mask, coll, SearchDeep
                Next
            End If
        Next
 
        Set current_folder = Nothing: Set folder = Nothing: Set subfolder = Nothing
    End If
End Function

пример использования:

Sub test_FoldersCollection()
    Dim coll As Collection, folder$
    folder$ = "D:ПРОЕКТЫExcelПримеры"        ' папка, в которой ищем подпапки

    ' получаем список подпапок с названием из 8 цифр
    Set coll = FoldersCollection(folder$, "########")
 
    ' выводим список найденных папок в окно Immediate
    For Each Item In coll
        Debug.Print Item
    Next
End Sub