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

时间:2013-06-13 02:33:31

标签: excel excel-vba directory vba

我目前正在尝试设置一个目录,并且正在尝试计算vba代码以从Excel电子表格创建目录。

    工作表的
  • Column A列出了所需的文件夹名称。
  • 这是我想要最终目录的示例。

    1. VIC \ Branch 1 \ Folder A
    2. VIC \ Branch 1 \ Folder B
    3. VIC \ Branch 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

1 个答案:

答案 0 :(得分:0)

对子文件夹使用数组,并为每个第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