Специально для примера я создал папку, в которой разместил несколько файлов различных типов и две подпапки. Вот так они выглядят:
Давайте рассмотрим несколько способов получения списка файлов.
Этот способ хорош тем, что в данном случае мы не подключаем дополнительных библиотек, а пользуемся только предустановленным функционалом. Способ подойдет, если вам необходимо просто получить список файлов в папке и не нужно выводить их размер, определять тип файла, дату его создания/изменения и т.п. Тут мы получаем только наименования файлов и больше ничего.
Вот там код данной функции, который выводит на лист 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).
В данном случае мы будем не просто получать названия файлов, но также определять тип файла, получать его размер и дату создания. Для этого нам потребуется использовать объект FileSystemObject. Он предоставляет нам сведения о файловой системе компьютера.
Однако, чтобы начать его использовать придется подключить одну библиотеку. Не пугайтесь, она есть на всех компьютерах с Windows, потому скачивать ничего не придется. Чтобы подключить ее необходимо:
Теперь перейдем к коду. Он немного упростился:
'************************************************************** ' 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
Результат работы программы следующий:
Напоследок разберем функцию, которая будет возвращать нам все файлы в текущей папке и во вложенных папках. Вообще это универсальная функция, которая подойдет на все случаи жизни. Смело копируйте ее в свой проект!
Итак перейдем к коду:
'************************************************************** ' 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. Также может принимать два необязательных параметра:
В целом по алгоритму комментарии лишние, все должно быть понятно. Основной момент хочу обратить на строку 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
Функция нам возвращает коллекцию файлов в папке и подпапках. Вот так:
Пример файла можете скачать по кнопке ниже и использовать в своей работе. Оставляйте комментарии, буду рад на них ответить.