使用VBA在excel列表中的所有子目录文件夹中创建相同的多个文件夹

我目前正试图建立一个目录，并试图计算出vba代码，从excel电子表格创建一个目录

工作表的A列列出了所需的文件夹名称。 这是一个我希望最终目录是什么样子的示例

VIC\分支机构1\文件夹A VIC\分支机构1\文件夹B VIC\分行2\文件夹A VIC\分行2\文件夹B 等 我已经能够创建状态和分支级别的文件夹，但是我在每个分支文件夹中创建相同的五个文件夹时遇到了困难。如果有人能帮助vb代码创建这些文件夹，我们将不胜感激

下面是我用来创建带有每个状态目录的分支文件夹的代码。我为每个州列表运行了它，只是更改了目录位置

多谢各位

Sub MakeFolders()
Dim xdir As String
Dim fso
Dim lstrow As Long
Dim i As Long
Set fso = CreateObject("Scripting.FileSystemObject")
lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To lstrow
xdir = "C:\Users\Nikki\Shared\VIC\" & Range("A" & i).Value
If Not fso.FolderExists(xdir) Then
fso.CreateFolder (xdir)
End If
Next
Application.ScreenUpdating = True
End Sub

---

对子文件夹使用一个数组，并对每个一级文件夹循环使用该数组

换行 vSubfolders=ArrayA，B，C 添加/删除第二级文件夹的步骤

Sub MakeFolders()
Dim xdir As String
Dim fso As Object
Dim lstrow As Long
Dim i As Long
Dim vSubfolders
Dim vSubFolder

vSubfolders = Array("A", "B", "C")
Set fso = CreateObject("Scripting.FileSystemObject")
lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To lstrow
xdir = "C:\Users\Nikki\Shared\VIC\" & Range("A" & i).Value
If Not fso.FolderExists(xdir) Then
fso.CreateFolder (xdir)
End If
For Each vSubFolder In vSubfolders
If Not fso.FolderExists(xdir & "\" & vSubFolder) Then
fso.CreateFolder (xdir & "\" & vSubFolder)
End If
Next
Next
Application.ScreenUpdating = True
End Sub

---

谢谢我要试一试。