Попытка создать папки и подпапки из Excel с помощью VBA

Question

У меня есть два столбца данных в Excel, которые я пытаюсь преобразовать в список папок и подпапок.Столбец A будет первым списком основных папок, а каждая запись столбца B будет подпапкой в ​​соответствующей папке из столбца A. Конечным результатом будет 20 папок, каждая с одной папкой внутри.Ранее я использовал этот код -

Sub MakeFolders()
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))
On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub

- для создания списка отдельных папок из одного столбца данных.Мне интересно, как я мог изменить этот код, чтобы создать список папок с первым столбцом, и чтобы каждая запись во втором столбце была подпапкой в ​​соответствующей папке из столбца А. Электронная таблица Excel выглядит следующим образом:

    Column A        Column B
1   Folder 1    Subfolder in Folder 1
2   Folder 2    Subfolder in Folder 2
3   Folder 3    Subfolder in Folder 3
4   Folder 4    Subfolder in Folder 4
5   Folder 5    Subfolder in Folder 5
6   Folder 6    Subfolder in Folder 6
7   Folder 7    Subfolder in Folder 7
8   Folder 8    Subfolder in Folder 8
9   Folder 9    Subfolder in Folder 9
10  Folder 10   Subfolder in Folder 10

С моим очень ограниченным пониманием VBA любая помощь будет признательна!

Answer 1

Не проверено:

Sub MakeFolders()
    Dim Rng As Range, rw As Range, c As Range
    Dim p As String, v As String

    Set Rng = Selection

    'process each selected row
    For Each rw In Rng.Rows
        p = ActiveWorkbook.Path & "\" 'set initial root path for this row
        'process each cell in this row
        For Each c In rw.Cells
            v = Trim(c.Value) 'what's in the cell?
            If Len(v) > 0 Then
                If Len(Dir(p & v, vbDirectory)) = 0 Then MkDir (p & v) 'create if not already there
                p = p & v & "\" 'append to path (regardless of whether it needed to be created)
            End If
        Next c
    Next rw

End Sub