如何通过单个路径在VBA中创建多级嵌套子文件夹？

AI 小北

2026-8-5

解决VBA创建嵌套多层文件夹的问题

原代码中的MkDir函数仅能在父文件夹已存在的前提下创建最后一层子文件夹，因此直接传入C:\SW\A\B\C这类多层路径会因上层文件夹不存在而执行失败。以下提供两种实用方案实现多层嵌套文件夹的批量创建：

方法1：递归创建多层文件夹

通过自定义递归函数，从最上层路径开始逐层检查并创建所有不存在的文件夹：

Sub MakeFolders()
    Dim fullPath As String
    fullPath = Range("E3").Value
    CreateNestedFolders fullPath
End Sub

Function CreateNestedFolders(ByVal path As String)
    Dim parentPath As String
    '统一路径分隔符格式
    path = Replace(path, "/", "\")
    
    '路径已存在则直接返回
    If Dir(path, vbDirectory) <> "" Then Exit Function
    
    '提取当前路径的父路径
    parentPath = Left(path, InStrRev(path, "\") - 1)
    
    '递归创建父路径（若父路径非空）
    If parentPath <> "" Then CreateNestedFolders parentPath
    
    '创建当前层级的文件夹
    MkDir path
End Function

方法2：循环遍历路径层级创建

拆分路径为各个层级，从根目录开始逐步拼接并创建文件夹：

Sub MakeFolders()
    Dim fullPath As String
    Dim pathParts As Variant
    Dim currentPath As String
    Dim i As Integer
    
    fullPath = Range("E3").Value
    '统一路径分隔符格式
    fullPath = Replace(fullPath, "/", "\")
    '按反斜杠拆分路径为层级数组
    pathParts = Split(fullPath, "\")
    
    '初始化根目录（如C:\）
    currentPath = pathParts(0) & "\"
    
    '遍历每个层级，逐步创建文件夹
    For i = 1 To UBound(pathParts)
        currentPath = currentPath & pathParts(i) & "\"
        '当前路径不存在则创建
        If Dir(currentPath, vbDirectory) = "" Then
            MkDir currentPath
        End If
    Next i
End Sub