使用VBA从Excel列表中的所有子目录文件夹中创build相同的多个文件夹

我目前正在试图build立一个目录，并试图从Excel电子表格中创build一个目录。

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

• 这是我想要最终目录的样子。

  1. VIC \ Branch 1 \ Folder A
  2. VIC \ Branch 1 \ Folder B
  3. VIC \ Branch 2 \ Folder A
  4. VIC \ Branch 2 \ Folder B等

我已经能够创build状态和分支级别的文件夹，但坚持在每个分支文件夹中创build相同的五个文件夹。 如果任何人都可以帮助VB代码创build这些文件夹，将不胜感激。

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

谢谢

 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