Надстройка
VBA-EXCEL
Надстройка для Excel содержит большой набор полезных функций, с помощью которых вы значительно сократите время и увеличите скорость работы с программой.
Подробнее...
Заказать макрос
Разрабатываем макросы на заказ. Любой сложности. Быстро и качественно.
Подробнее...
Возможности Excel » Макросы » Список файлов в папке

Как получить список файлов в Excel с помощью VBA

Очень распространенная задача - получить список файлов из папок и подпапок на лист Excel. Кто-то делает каталог файлов для какого-нибудь отчета. Кто-то хочет обработать файлы в своей программе. В данной статье рассмотрим несколько вариантов реализации данной задачи от самого простого, до расширенного с поиском файлов по вложенным каталогам.

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

Папка с файлами и каталогами 

Давайте рассмотрим несколько способов получения списка файлов.

Способ 1. Использование функции Dir

Этот способ хорош тем, что в данном случае мы не подключаем дополнительных библиотек, а пользуемся только предустановленным функционалом. Способ подойдет, если вам необходимо просто получить список файлов в папке и не нужно выводить их размер, определять тип файла, дату его создания/изменения и т.п. Тут мы получаем только наименования файлов и больше ничего.

Вот там код данной функции, который выводит на лист 1 перечень файлов.

'**************************************************************
' Sub            : ExampleOne
' Author         : Алексей Желтов
' Date           : 15.06.2020
' Purpose        : Вывод всех файлов в папке на лист
'**************************************************************
Sub ExampleOne()

    Dim Sh As Worksheet
    Dim Folder As String
    Dim FileName As String
    Dim i As Long

    Set Sh = ThisWorkbook.Sheets(1)
    Folder = Sh.Cells(3, 2)

    ' Проверка корректности введенных данных
    If PathExists(Folder) = False Then
        MsgBox "Указанной папки не существует", 16, "Ошибка исходных данных"
        Exit Sub
    End If

    ' Удаляем содержимое
    Sh.Rows("7:" & Sh.Range("A7").End(xlDown).Row).Delete Shift:=xlUp
    
    i = 7
    FileName = Dir(Folder & "/", vbNormal)
    Do While FileName <> ""
        Sh.Cells(i, 1) = i - 6
        Sh.Cells(i, 2) = FileName
        i = i + 1
        
        ' переход к следующему файлу
        FileName = Dir
    Loop

End Sub

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

'**************************************************************
' Function       : PathExists
' Author         : Алексей Желтов
' Date           : 15.06.2020
' Purpose        : Возвращает ИСТИНА если путь pname существует
'**************************************************************
Private Function PathExists(pname As String) As Boolean
    On Error Resume Next
    If Dir(pname, vbDirectory) = "" Then
        PathExists = False
    Else
        PathExists = (GetAttr(pname) And vbDirectory) = vbDirectory
    End If
End Function

Вот так выглядит результат работы функции. Программа записала список файлов на текущий лист Excel.

Вывод списка файлов на лист

Здесь мы не делали проверку на тип файла и вывели все файлы которые у нас были. 

Если же необходимо отобрать только определенные типы файлов, например Excel файлы, то в нашем коде необходимо сделать дополнительную проверку:

    Do While FileName <> ""
    
        If LCase(FileName) Like "*xls*" Then
            Sh.Cells(i, 1) = i - 6
            Sh.Cells(i, 2) = FileName
            i = i + 1
        End If
        ' переход к следующему файлу
        FileName = Dir
    Loop

Знак "*" означает любой набор символов. Таким образом, мы учли различные версии файлов Excel (xls, xlsx, xlsm).

Способ 2. Используем объект FileSystemObject

В данном случае мы будем не просто получать названия файлов, но также определять тип файла, получать его размер и дату создания. Для этого нам потребуется использовать объект FileSystemObject. Он предоставляет нам сведения о файловой системе компьютера.

Однако, чтобы начать его использовать придется подключить одну библиотеку. Не пугайтесь, она есть на всех компьютерах с Windows, потому скачивать ничего не придется. Чтобы подключить ее необходимо:

  1. Открыть пункт меню Tools и выбрать пункт References.
    Открыть пункт меню Tools и выбрать пункт References
  2. Выбрать ссылку на библиотеку Microsoft Scripting Runtime
    Выбрать ссылку на библиотеку Microsoft Scripting Runtime. 
  3. Нажать Ок.

Теперь перейдем к коду. Он немного упростился:

'**************************************************************
' Sub            : ExampleTwo
' Author         : Алексей Желтов
' Date           : 15.06.2020
' Purpose        : Вывод всех файлов в папке на лист
'**************************************************************
Sub ExampleTwo()
    
    Dim Sh As Worksheet
    Dim FSO As New FileSystemObject
    Dim FolderPath As String
    Dim MyFolder As Folder
    Dim iFile As File
    Dim i As Long
    
    Set Sh = ThisWorkbook.Sheets(2)
    FolderPath = Sh.Cells(3, 2)
    
    ' Проверка корректности введенных данных
    If Not FSO.FolderExists(FolderPath) Then
        MsgBox "Указанной папки не существует", 16, "Ошибка исходных данных"
        Exit Sub
    End If
    
    ' Удаляем содержимое
    Sh.Rows("7:" & Sh.Range("A7").End(xlDown).Row).Delete Shift:=xlUp
    
    Set MyFolder = FSO.GetFolder(FolderPath)
     
    i = 7
    For Each iFile In MyFolder.Files
        Sh.Cells(i, 1) = i - 6
        Sh.Cells(i, 2) = iFile.Name
        Sh.Cells(i, 3) = iFile.Type
        Sh.Cells(i, 4) = iFile.DateCreated
        Sh.Cells(i, 5) = iFile.Size
        i = i + 1
    Next
     
End Sub

Обратите внимание на переменные. Переменная FSO - это новый экземпляр объекта FileSystemObject. Тут мы его объявляем и сразу создаем. Директива New очень важна, многие тут допускают ошибку. Также создаем объекты MyFolder и iFile - это тоже объекты FileSystemObject

    Dim Sh As Worksheet
    Dim FSO As New FileSystemObject ' объявляем и создаем новый экземпляр объекта 
    Dim FolderPath As String
    Dim MyFolder As Folder
    Dim iFile As File
    Dim i As Long

Далее делаем проверку на существование папки. В данном случае нам не нужна дополнительная функция , мы пользуемся методом FolderExists объекта (класса) FileSystemObject.

Ну и остается аналогично перебрать все файлы в директории. Тут удобно использовать цикл For Each - Next.

    For Each iFile In MyFolder.Files
        Sh.Cells(i, 1) = i - 6
        Sh.Cells(i, 2) = iFile.Name ' название файла
        Sh.Cells(i, 3) = iFile.Type ' тип файла
        Sh.Cells(i, 4) = iFile.DateCreated ' дата создания
        Sh.Cells(i, 5) = iFile.Size ' размер
        i = i + 1
    Next

Результат работы программы следующий:

Получаем список файлов с помощью FileSystemObject

Способ 3. Создаем функцию, которая возвращает файлы в папке и подпапках

Напоследок разберем функцию, которая будет возвращать нам все файлы в текущей папке и во вложенных папках. Вообще это универсальная функция, которая подойдет на все случаи жизни. Смело копируйте ее в свой проект! 

Итак перейдем к коду:

'**************************************************************
' Function       : GetFiles
' Author         : Алексей Желтов
' Date           : 15.06.2020
' Purpose        : Получение файлов из папок и подпапок
'**************************************************************
Public Function GetFiles(ByVal Path As String, Optional ByVal Filter As String = "*", Optional ByVal Nesting As Long = 100) As Collection
    Dim MainFolder As Folder
    Dim iFolder As Folder
    Dim iFile As File
    Dim FSO As New FileSystemObject
    Dim MainColl As New Collection
    Dim iColl As Collection
    Dim spltFilter() As String
    Dim i As Long
    
    Set MainFolder = FSO.GetFolder(Path)
    If MainFolder Is Nothing Then Exit Function
    spltFilter = Split(Filter, ",")
    
    ' Перебираем файлы
    For Each iFile In MainFolder.Files
        ' Игнорируем временные файлы
        If InStr(1, iFile.Name, "~") = 0 Then
            ' Проверяем фильтры файлов
            For i = 0 To UBound(spltFilter)
                If LCase(iFile.Name) Like "*" & LCase(spltFilter(i)) Then
                    MainColl.Add iFile, iFile.Path
                End If
            Next
        End If
    Next
    
    ' Перебираем вложенные папки
    If Nesting > 0 Then
        For Each iFolder In MainFolder.SubFolders
            ' рекурсивный вызов функции
            Set iColl = GetFiles(iFolder.Path, Filter, Nesting - 1)
            
            'добавляем файлы из вложенных папок
            For i = 1 To iColl.Count
                MainColl.Add iColl(i), iColl(i).Path
            Next
        Next
    End If
    
    Set GetFiles = MainColl
End Function

Разберем основные моменты этой функции. На вход она принимает один обязательный аргумент - это путь к папке Path. Также может принимать два необязательных параметра:

  • Filter - перечисление списка файлов, которые мы хотим получить. Перечислять необходимо через запятую, например "doc, xls*". Вы можете использовать символ "*" чтобы включить сравнение по шаблону. По умолчанию фильтр отсутствует и возвращаются все типы файлов.
  • Nesting - вложенность. Это максимальное число вложенных папок в которые "проваливается" алгоритм. По умолчанию равно 100.

В целом по алгоритму комментарии лишние, все должно быть понятно. Основной момент хочу обратить на строку 38.

        For Each iFolder In MainFolder.SubFolders
            ' рекурсивный вызов функции
            Set iColl = GetFiles(iFolder.Path, Filter, Nesting - 1)
            
            'добавляем файлы из вложенных папок
            For i = 1 To iColl.Count
                MainColl.Add iColl(i), iColl(i).Path
            Next
        Next

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

Теперь когда наша функция готова, просто используем ее где нам требуется вот так:

'**************************************************************
' Sub            : ExampleThree
' Author         : Алексей Желтов
' Date           : 15.06.2020
' Purpose        : Вывод всех файлов в папке на лист
'**************************************************************
Sub ExampleThree()
    
    Dim Sh As Worksheet
    Dim FolderPath As String
    Dim iFile As File
    Dim i As Long
    Dim Coll As Collection
    Dim FSO As New FileSystemObject
    
    Set Sh = ThisWorkbook.Sheets(3)
    FolderPath = Sh.Cells(3, 2)
    
    Set Coll = GetFiles(FolderPath)
    
    For i = 1 To Coll.Count
        Set iFile = Coll(i)
        Sh.Cells(i + 6, 1) = i
        Sh.Cells(i + 6, 2) = iFile.Name
        Sh.Cells(i + 6, 3) = FSO.GetFolder(iFile.ParentFolder).Name
        Sh.Cells(i + 6, 4) = iFile.Type
        Sh.Cells(i + 6, 5) = iFile.DateCreated
        Sh.Cells(i + 6, 6) = iFile.Size
    Next
     
End Sub

Функция нам возвращает коллекцию файлов в папке и подпапках. Вот так:

Список файлов в папке и вложенных папках

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

Скачать

Комментарии:

comments powered by Disqus