已有一个Excel表格，用VBA批量新建文件夹

不知道标题怎么写。
已经有了这样一组数据

然后需要根据这两组数据新建文件夹，代码如下

Sub 建文件夹()
    Dim i As Integer '用于下方数组
    Dim Arr1(), Arr2() '定义一个数组，不能定义大小和类型
    Dim Fso, Fld    '定义文件路径
    Dim rowmax  '找到数据的行数
    
    start_time = Timer  '计时开始
    
'数据的行数
    rowmax = [A1048576].End(xlUp).Row
'把两列数据分别赋值给两个个数组
    Arr1 = Range("A2:A" & rowmax)
    Arr2 = Range("B2:B" & rowmax)
'选择建文件夹的路径
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Fld = Fso.getfolder(CreateObject("Shell.Application").BrowseForFolder(0, "请选择需要创建文件夹的根目录", 0, "").Self.Path & "")

'开始批量新建文件夹
    For i = 1 To UBound(Arr1)
        FolderName = Arr1(i, 1) & " " & Arr2(i, 1)
        If Dir(Fld & "\" & FolderName, vbDirectory) = vbNullString Then  '如果文件夹不存在，则新建
        VBA.MkDir (Fld & "\" & FolderName)
        End If
    Next    
'建好了

    cost_time = Timer - start_time  '计时结束，计算用时
    Range("D6") = cost_time
End Sub 

完成

• 202003072230 更新
  如果是需要建二级目录，在第一次for循环里再加一个for循环即可，如下图所示。

Sub 建文件夹()
    Dim i As Integer '用于下方数组
    Dim Arr1(), Arr2() '定义一个数组，不能定义大小和类型
    Dim Fso, Fld    '定义文件路径
    Dim rowmax  '找到数据的行数
    
    start_time = Timer  '计时开始
    
'数据的行数
    rowmax = [A1048576].End(xlUp).Row
'把两列数据分别赋值给两个个数组
    Arr1 = Range("A2:A" & rowmax)
    Arr2 = Range("B2:B" & rowmax)
'选择建文件夹的路径
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Fld = Fso.getfolder(CreateObject("Shell.Application").BrowseForFolder(0, "请选择需要创建文件夹的根目录", 0, "").Self.Path & "")

'开始批量新建文件夹
    For i = 1 To UBound(Arr1)
        FolderName = Arr1(i, 1) & " " & Arr2(i, 1)
        If Dir(Fld & "\" & FolderName, vbDirectory) = vbNullString Then  '如果文件夹不存在，则新建
        VBA.MkDir (Fld & "\" & FolderName)	' 新文件建好了
        ' 见上方的一行代码，此时，已经建好了一个文件夹。文件夹的全路径是：Fld & "\" & FolderName
        ' 如果需要建二级文件夹的话，在已经建好的文件夹下继续新建文件夹就行了
'''''''''''''''''''''''''''''以下''''''''''''''''''''''''''''''''''''''''''''		
		' 下方For循环模拟建二级文件夹
        For j = 0 To 10
            VBA.MkDir (Fld & "\" & FolderName & "\" & "测试文件" & j)
        Next
'''''''''''''''''''''''''''''以上''''''''''''''''''''''''''''''''''''''''''''
        End If
    Next
'建好了
    cost_time = Timer - start_time  '计时结束，计算用时
    Range("D6") = cost_time
End Sub

• 这里操作

'''''''''''''''''''''''''''''以下''''''''''''''''''''''''''''''''''''''''''''		
		' 下方For循环模拟建二级文件夹
        For j = 0 To 10
            VBA.MkDir (Fld & "\" & FolderName & "\" & "测试文件" & j)
        Next
'''''''''''''''''''''''''''''以上''''''''''''''''''''''''''''''''''''''''''''

最后效果如下图所示
一级目录

二级目录