Всё-таки и при помощи FileSystemObject можно получить список файлов. Но через коллекцию.
Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _ Optional ByVal SearchDeep As Long = 999) As Collection ' Получает в качестве параметра путь к папке FolderPath, ' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением) ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются). ' Возвращает коллекцию, содержащую полные пути найденных файлов ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO) Dim FSO As Object
Set FilenamesCollection = New Collection ' создаём пустую коллекцию Set FSO = CreateObject("Scripting.FileSystemObject") ' создаём экземпляр FileSystemObject GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск Set FSO = Nothing ' очистка строки состояния Excel End Function
Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _ ByRef FileNamesColl As Collection, ByVal SearchDeep As Long) ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO ' перебор папок осуществляется в том случае, если SearchDeep > 1 ' добавляет пути найденных файлов в коллекцию FileNamesColl On Error Resume Next Dim curfold As Object Dim fil As Object Dim sfol As Variant Set curfold = FSO.GetFolder(FolderPath) If Not curfold Is Nothing Then ' если удалось получить доступ к папке ' раскомментируйте эту строку для вывода пути к просматриваемой ' в текущий момент папке в строку состояния Excel ' Application.StatusBar = "Поиск в папке: " & FolderPath For Each fil In curfold.Files ' перебираем все файлы в папке FolderPath If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path Next SearchDeep = SearchDeep - 1 ' уменьшаем глубину поиска в подпапках If SearchDeep Then ' если надо искать глубже For Each sfol In curfold.SubFolders ' перебираем все подпапки в папке FolderPath GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep Next End If Set fil = Nothing Set curfold = Nothing ' очищаем переменные End If End Function
Ну и пример использования. Обрабатывается не только папка, но и входящие в неё подпапкиPublic Sub FileInFolder() ' Пример использования функции On Error GoTo FileInFolder_Error Dim folder$, coll As Collection, File
folder$ = "\\I-server-one\shara\ОНС_модуль_загрузка\" If Dir(folder$, vbDirectory) = "" Then MsgBox "Не найдена папка «" & folder$ & "»", vbCritical, "Нет папки" Exit Sub ' выход, если папка не найдена End If
Set coll = FilenamesCollection(folder$) ' можно и так (folder$, "*.xls") - получаем список файлов XLS из папки If coll.Count = 0 Then MsgBox "В папке «" & Split(folder$, "\")(UBound(Split(folder$, "\")) - 1) & _ "» нет ни одного подходящего файла!", _ vbCritical, "Файлы для обработки не найдены" Exit Sub ' выход, если нет файлов End If
' перебираем все найденные файлы For Each File In coll Debug.Print File ' выводим имя файла в окно Immediate Next
Exit_FileInFolder:
On Error GoTo 0 Exit Sub
FileInFolder_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FileInFolder" Resume Exit_FileInFolder
End Sub
Источник тот же. |
Примечание к примеру
