Если я правильно понимаю, ваши требования следующие:
- Начните с набора корневых путей
- Итерируйте рекурсивно по всем файлам в каждом корневом пути
- Для каждого файла в результирующей коллекции, если это файл Excel, добавьте в окончательный список для дальнейшей обработки
Давайте начнем с первых двух пунктов.Я хотел бы предложить следующий код (обязательно добавьте ссылку на Microsoft Scripting Runtime через Инструменты -> Ссылки ... в меню редактора VBA):
Public Function GetFiles(ByVal roots As Variant) As Collection
Select Case TypeName(roots)
Case "String", "Folder"
roots = Array(roots)
End Select
Dim results As New Collection
Dim fso As New Scripting.FileSystemObject
Dim root As Variant
For Each root In roots
AddFilesFromFolder fso.GetFolder(root), results
Next
Set GetFiles = results
End Function
Private Sub AddFilesFromFolder(folder As Scripting.folder, results As Collection)
Dim file As Scripting.file
For Each file In folder.Files
results.Add file
Next
Dim subfolder As Scripting.folder
For Each subfolder In folder.SubFolders
AddFilesFromFolder subfolder, results
Next
End Sub
Функцию GetFiles можно вызвать, передав одну строку (или Folder):
Debug.Print GetFiles("c:\users\win8\documents").Count
или все, что можно повторить с помощью For Each- массив, коллекция, Dictionary или даже объект Excel Range:
Dim allFiles As Collection
Set allFiles = GetFiles(ws2.Range("A1:A" & Rows.Count).End(xlUp)) 'from question
GetFiles в том виде, как он есть, является гибким для многих случаев использования и не используетлюбые специфичные для Excel объекты.Чтобы ограничить результаты только файлами Excel, вы можете создать новую коллекцию и добавить только файлы Excel в новую коллекцию:
'You could filter by the File object's Type property
Sub GetExcelFilesByType()
Dim allFiles As Collection
Set allFiles = GetFiles(ws2.Range("A1:A" & Rows.Count).End(xlUp)) 'from question
Dim excelFiles As New Collection
Dim file As Scripting.File
For Each file In allFiles
If file.Type = "Microsoft Excel Worksheet" Then excelFiles.Add file
Next
End Sub
' Or you could filter by extension, using the FileSystemObject.GetExtensionName method
Sub GetExcelFilesByExtensionName()
Dim allFiles As Collection
Set allFiles = GetFiles(ws2.Range("A1:A" & Rows.Count).End(xlUp)) 'from question
Dim excelFiles As New Collection
Dim fso As New Scripting.FileSystemObject
Dim file As Scripting.File
For Each file In allFiles
Select Case fso.GetExtensionName(file.path)
Case "xls", "xlsb", "xlsm"
excelFiles.Add file
End Select
Next
End Sub
Либо вы получите Collection из Fileобъекты, только файлы Excel, из набора корневых папок.
Примечания
- Этот код рекурсивно добавляет все файлы (не толькоФайлы Excel) в одну коллекцию (в
GetFiles), а затем отфильтровывать файлы не из Excel в новую коллекцию.Это может быть менее производительным, чем добавление только файлов Excel в исходную коллекцию, но это ограничит GetFiles только этим сценарием. - Если вы хотите вставить результаты в лист ExcelВы можете перебирать
excelFiles и вставлять каждый путь в лист.Кроме того, вы можете преобразовать excelFiles в массив и использовать свойство Value объекта Excel Range, чтобы установить все значения из массива, без использования For Each.
Ссылки
Среда выполнения сценариев Microsoft
VBA