Получение списка папок 1, 2 и 3 уровней вложенности с помощью кода VBA Excel. SubFolders — коллекция подпапок, расположенных в указанной папке.
Свойство SubFolders объекта Folder
Обход папок разных уровней вложенности можно использовать не только для того, чтобы отобразить список папок на экране, но и для работы с находящимися в них файлами.
Список папок 1 уровня вложенности
Получение списка папок 1 уровня вложенности:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
Sub ShowFolderSublevel1() Dim fso As FileSystemObject, fo As Folder, fo1 As Folder, s As String 'Указываем адрес исходной папки s = "C:\Users" 'Создаем экземпляр FileSystemObject Set fso = CreateObject("Scripting.FileSystemObject") 'Присваиваем переменной fo ссылку на указанную папку Set fo = fso.GetFolder(s) 'Отключаем обработчик ошибок On Error Resume Next 'Обходим циклом коллекцию подпапок в указанной папке For Each fo1 In fo.SubFolders 'Печатаем полное имя текущей подпапки в окне Immediate Debug.Print fo1 '.Path - по умолчанию Next 'Включаем обработчик ошибок On Error GoTo 0 End Sub |
Если в исходной папке нет подпапок, то применение свойства SubFolders вызовет ошибку. Чтобы пропускать такие ошибки, мы отключаем обработчик ошибок на время работы циклов.
Список папок 2 уровня вложенности
Получение списка папок 1 и 2 уровней вложенности:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
Sub ShowFolderSublevel2() Dim fso As FileSystemObject, fo As Folder, fo1 As Folder, fo2 As Folder, s As String s = "C:\Users" Set fso = CreateObject("Scripting.FileSystemObject") Set fo = fso.GetFolder(s) On Error Resume Next 'Обходим коллекцию подпапок 1 уровня вложенности For Each fo1 In fo.SubFolders Debug.Print fo1 'Обходим коллекцию подпапок 2 уровня вложенности For Each fo2 In fo1.SubFolders 'Перед полным именем подпапки 2 уровня добавляем 4 пробела Debug.Print Space(4) & fo2 Next Next On Error GoTo 0 End Sub |
Список папок 3 уровня вложенности
Получение списка папок 1, 2 и 3 уровней вложенности:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
Sub ShowFolderSublevel3() Dim fso As FileSystemObject, fo As Folder, fo1 As Folder, fo2 As Folder, fo3 As Folder, s As String s = "C:\Users" Set fso = CreateObject("Scripting.FileSystemObject") Set fo = fso.GetFolder(s) On Error Resume Next 'Обходим коллекцию подпапок 1 уровня вложенности For Each fo1 In fo.SubFolders Debug.Print fo1 'Обходим коллекцию подпапок 2 уровня вложенности For Each fo2 In fo1.SubFolders 'Перед полным именем подпапки 2 уровня добавляем 4 пробела Debug.Print Space(4) & fo2 'Обходим коллекцию подпапок 3 уровня вложенности For Each fo3 In fo2.SubFolders 'Перед полным именем подпапки 3 уровня добавляем 8 пробелов Debug.Print Space(8) & fo3 Next Next Next On Error GoTo 0 End Sub |
Обратите внимание, если вы будете использовать для тестов папку «C:\Users» как исходную, все строки с наименованиями подпапок в окне Immediate не уместятся (ограничение — 200 строк).
Как получить список файлов в папке, смотрите в статье VBA Excel. Список файлов в папке.
Фразы для контекстного поиска: вложенная папка, вложенные папки, список подпапок, обход подпапок, вывод списка.