Получить список названий папок, находящихся в папках, которые находятся в одной папке

Sub Собрать_названия_папок_в папках_из_главной_папки()
Dim fso, myPath, myFolder, myFile, myFiles(), myFolders(), myFolder_1, i
 
myPath = InputBox("Введите путь к главной папке", "Путь", "D:\1")
 
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    Set myFolder = fso.GetFolder(myPath)
 
    If myFolder.subfolders.Count = 0 Then 'этот иф по идее не нужен, ибо будет препятствовать выполнению кода для последующих папок, если в очередной папке не окажется папок
        MsgBox "В папке «" & myPath & "» папок нет."
        Exit Sub
    End If
 
 
ReDim myFolders(1 To myFolder.subfolders.Count)
   
 
    For Each myFolder_1 In myFolder.subfolders
        i = i + 1
'        myFiles(i) = myFile.Path
        Cells(i, 1) = myFolder_1.Name
        Cells(i, 2) = myFolder_1.Size
        Cells(i, 3) = myFolder_1.subfolders.Count
        j = i
' вот эта часть кода не работает
        For Each myFolder_2 In myFolder.subfolders
            Cells(j, 4) = myFolder_2.subfolders.Name
            j = j + 1
        Next
'до этого места бред написан. Дальше работает всё.
 
        
    Next
 
 
End Sub

For Each myFolder_2 In myFolder_1.subfolders

With wscript.Arguments
    If .Count = 0 Then
        MsgBox "This script must be run with path of folder", 16
        wscript.Quit
    End If
    BoxIn = .Item(0)
End With
 
Set XLS = CreateObject("Excel.Application")
With XLS
    .Visible = True 'False
    .Workbooks.Add
End With
 
AllFoldersVBS CreateObject("Scripting.FileSystemObject"), BoxIn, 0, 0, XLS
XLS.Columns("A:AA").EntireColumn.AutoFit
 
Sub AllFoldersVBS(FSO, inDir, i, ii, XLS)    ' ---------------------------------------------
    Set F = FSO.GetFolder(inDir)
    Set SubF = F.SubFolders
    If i = 0 Then
        XLS.Range("A1").Offset(i, 0) = F.Path
        i = i + 1
    Else
        Arr = Split(F.Path, "\")
        j = UBound(Arr, 1)
        If j > ii Then i = i - 1
        ii = j
        XLS.Range("A1").Offset(i, ii - 1) = Arr(ii)
    End If
    i = i + 1
    For Each Folder In SubF
        AllFoldersVBS FSO, inDir + "\" + Folder.Name, i, ii, XLS
    Next
End Sub