Загрузка списка подпапок (2 уровней) в Excel

Sub ЗагрузкаСпискаПодпапок()
    On Error Resume Next: Application.ScreenUpdating = False
    FolderPath$ = Trim([c1])    ' путь к папке - из ячейки С1
    If Right(FolderPath$, 1) <> "\" Then FolderPath$ = FolderPath$ & "\"
 
    Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject

    Set curfold = FSO.GetFolder(FolderPath$)
    ' выводим информацию о главной папке в ячейку E1
    [e1] = "Файлов: " & curfold.Files.Count & "; папок: " & curfold.SubFolders.Count
 
    Dim ra As Range
    For Each folder In curfold.SubFolders    ' перебираем все подпапки в папке FolderPath
        f1 = folder.Name    ' название первой подпапки
        ' выводим информацию в строку состояния
        Application.StatusBar = "Обрабатывается папка " & f1: DoEvents
 
        For Each subfolder In folder.SubFolders    ' перебираем все подпапки в папке curfold
            n = n + 1: DoEvents: f2 = subfolder.Name    ' название вложенной подпапки
            info = "Файлов: " & subfolder.Files.Count & "; папок: " & subfolder.SubFolders.Count
            Size = subfolder.Size    ' размер папки
            
            ' диапазон для вставки информации об очередной папке
            Set ra = Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 5)
            ra.Value = Array(n, f1, f2, info, Size) ' заполняем ячейки данными
            
            ' добавляем гиперссылки в 2 ячейки
            ra.Hyperlinks.Add ra.Cells(2), folder.Path, "", _
                              "Открыть папку " & f1 & vbNewLine & " в директории " & FolderPath$
            ra.Hyperlinks.Add ra.Cells(3), subfolder.Path, "", _
                              "Открыть подпапку " & f2 & vbNewLine & " в папке " & f1
        Next subfolder
    Next folder
    Set FSO = Nothing
    Application.StatusBar = False ' очистка строки состояния Excel
End Sub