VBA：用MkDir函数创建多层文件夹

一、假设问题

在VBA中，如果直接用MkDir函数创建文件夹，只能在已有文件夹里创建一层子文件夹。如：

已存在路径：C:\A

不存在路径：C:\A\B

现在如果要创建路径：C:\A\B\D\F

这种情况下，用MkDir直接是创建不了的，当然可以用其他对象创建，但是如果非得用MkDir函数创建，也不难。

二、解决思路

1. 把需要创建的路径

C:\A\B\D\F

用“\”分割成数组，用Dir()函数依次判断每层路径

第1次判断：

C:

第2次判断：

C:\A

第3次判断：

C:\A\B

……

第n次判断：

C:\A\B\D\F

2. 每次判断路径如果存在，则不用创建；反之，用MkDir创建路径。即一级一级创建。

三、示例代码

rem 创建函数，也可以写成sub过程
Function 创建多层文件夹(aimPath As String)

    '定义pathArr为后面分解目标路径的数组，subPath为每次组合的判断路径
    Dim pathArr, subPath As String

    '如果路径为空，退出函数（过程），后面代码不执行
    If aimPath = "" Then Exit Function
    
    'pathArr数组赋值
    pathArr = Split(aimPath, "\")

    '从路径数组的下标到上标，从前向后循环各级路径，逐级判断
    For i = LBound(pathArr) To UBound(pathArr)

        '子路径为前面多项的拼接
        For j = 0 To i
            subPath = subPath & pathArr(j) & "\"
        Next
        subPath = Left(subPath, Len(subPath) - 1)

        '如果用Dir()函数检测组合的路径，如果结果为空，说明路径不存在
        If Dir(subPath & "\") = Empty Then
            If i = 0 Then

                '当第判断第一级路径（即盘符层次）时，如果不存在，即盘符不存在
                MsgBox "盘符不存在！", vbInformation, "提示"
                Exit Function
            End If
            Debug.Print subPath & " 路径不存在"

            '路径不存在，就用MkDir创建路径，为创建下一层路径作准备
            MkDir subPath
        End If
        
        '组合路径判断完一层（次）后，清空，否则下次路径就有多余的
        subPath = ""
    Next
    Debug.Print "完成"
End Function

rem 创建文件夹的主过程
Sub test()
    Dim 路径 As String
    路径 = "C:\A\B\D\F"
    '创建路径“C:\A\B\D\F”
    Call 创建多层文件夹(路径)
End Sub