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

Question

我目前正在尝试建立一个目录，并尝试制定 vba 代码以从 excel 电子表格创建一个目录。

• Column A的工作表列出了所需的文件夹名称。

• 这是我希望最终目录看起来像的示例。

  1. VIC\分支 1\文件夹 A
  2. VIC\分支 1\文件夹 B
  3. VIC\分支 2\文件夹 A
  4. VIC\Branch 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

Answer 1

为子文件夹使用一个数组，并为每个第一级文件夹循环遍历该数组。

更改此行
vSubfolders = Array("A", "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