Папки и подпапки

[Rik3D]

Как сделать так, чтобы код считал количество всех папок и выводил на лист (этот код ниже считает только количество папок в главной папке, то есть, если в главной папке 4 папки, то он выведет 4, а если в тех 4 папках содержутся подпапки, то он их не подсчитает и выведет всего 4 папки, те которые в главной) и надо что бы он выводил на лист в столбик все имена папок и подпапок в главной папке.
Заранее большое спасибо!

Код: Выделить всё

Sub папки()
On Error Resume Next
Dim fso, fsFolder, fsfolder2
Set fso = CreateObject("scripting.filesystemobject")
Set fsFolder = fso.getFolder(FolderName)
Set DestRange = Worksheets(2).Range("A1")
DestRange.CurrentRegion.ClearContents
For Each fsfolder2 In fsFolder.subfolders
Set NewLine = DestRange.Offset(DestRange.CurrentRegion.Rows.Count, 0)
NewLine.Offset(0, 0).Value = fsfolder2.Name
Next
Worksheets("СТАТИСТИКА").Cells(6, 3).Value = fsFolder.Size
Worksheets("СТАТИСТИКА").Cells(2, 2).Value = fsFolder.subfolders.Count
Worksheets("ПАПКИ").Cells(1, 1).delete Shift:=xlUp
Worksheets("ПАПКИ").Cells.EntireColumn.AutoFit
End Sub

[Igor_123]

Ты издеваешься???
Я же тебе дал код.
Или это в юмор надо???

[Rik3D]

Нет!
код дал, только он сначало ошибки выдавал, потом на 3 раз прокатило, и теперь всё ОК!!!
Спасибо Igor_123!!!!

[Rik3D]

Хотя, в юмор можно поместить! хе-хе