Vba FileSystemObject.CreateFolder创建目录和子目录

我想用以下代码创建一个目录和一个子目录：

Public fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
fso.CreateFolder ("C:\Users\<my_username>\DataEntry\logs")

---

我使用的是Excel VBA 2007/2010，需要一次创建一个文件夹。您可以使用如下代码执行此操作：

Sub tgr()

    Dim strFolderPath As String
    Dim strBuildPath As String
    Dim varFolder As Variant

    strFolderPath = "C:\Users\<my_username>\DataEntry\logs"

    If Right(strFolderPath, 1) = "\" Then strFolderPath = Left(strFolderPath, Len(strFolderPath) - 1)
    For Each varFolder In Split(strFolderPath, "\")
        If Len(strBuildPath) = 0 Then
            strBuildPath = varFolder & "\"
        Else
            strBuildPath = strBuildPath & varFolder & "\"
        End If
        If Len(Dir(strBuildPath, vbDirectory)) = 0 Then MkDir strBuildPath
    Next varFolder

    'The full folder path has been created regardless of nested subdirectories
    'Continue with your code here

End Sub

Sub-tgr（）
将strFolderPath设置为字符串
将strBuildPath设置为字符串
Dim varFolder作为变体
strFolderPath=“C:\Users\\DataEntry\logs”
如果Right（strFolderPath，1）=“\”，则strFolderPath=Left（strFolderPath，Len（strFolderPath）-1）
对于拆分中的每个varFolder（strFolderPath，“\”）
如果Len（strBuildPath）=0，则
strBuildPath=varFolder&“\”
其他的
strBuildPath=strBuildPath&varFolder&“\”
如果结束
如果Len（Dir（strBuildPath，vbDirectory））=0，则MkDir strBuildPath
下一个文件夹
'已创建完整文件夹路径，而不考虑嵌套的子目录
'在此处继续使用您的代码
端接头

tigeravatar的循环回答可能有用，但它有点难读懂。FileSystemObject没有自己处理字符串，而是提供了路径操作函数，递归比循环更容易读取

以下是我使用的函数：

Function CreateFolderRecursive(path As String) As Boolean
    Dim FSO As New FileSystemObject

    'If the path exists as a file, the function fails.
    If FSO.FileExists(path) Then
        CreateFolderRecursive = False
        Exit Function
    End If

    'If the path already exists as a folder, don't do anything and return success.
    If FSO.FolderExists(path) Then
        CreateFolderRecursive = True
        Exit Function
    End If

    'recursively create the parent folder, then if successful create the top folder.
    If CreateFolderRecursive(FSO.GetParentFolderName(path)) Then
        If FSO.CreateFolder(path) Is Nothing Then
            CreateFolderRecursive = False
        Else
            CreateFolderRecursive = True
        End If
    Else
        CreateFolderRecursive = False
    End If
End Function

---

同意MarkD关于利用递归的建议，这就是我来这里寻找的代码。在提供的路径使用不存在的根文件夹的情况下，将导致无限循环。添加到MarkD的解决方案以检查零长度路径

Function CreateFolderRecursive(path As String) As Boolean
    Static FSO As FileSystemObject
 
    'Initialize FSO variable if not already setup
    If FSO Is Nothing Then Set lFSO = New FileSystemObject

    'Is the path paramater populated
    If Len(path) = 0 Then
      CreateFolderRecursive = False
      Exit Function
    End If

    'If the path exists as a file, the function fails.
    If FSO.FileExists(path) Then
        CreateFolderRecursive = False
        Exit Function
    End If
 
    'If the path already exists as a folder, don't do anything and return success.
    If FSO.FolderExists(path) Then
        CreateFolderRecursive = True
        Exit Function
    End If
 
    'recursively create the parent folder, then if successful create the top folder.
    If CreateFolderRecursive(FSO.GetParentFolderName(path)) Then
        If FSO.CreateFolder(path) Is Nothing Then
            CreateFolderRecursive = False
        Else
           CreateFolderRecursive = True
        End If
    Else
        CreateFolderRecursive = False
    End If
End Function

---

试着用@nicholas79171，我也试过，但没用。我想我可能知道什么了。VBA似乎无法创建嵌套的子目录？我已经更新了我的问题第一个目录是否已创建？@nicholas79171第一个目录也未创建。现在，我将代码更改为使用两个单独的目录创建，一个用于

数据条目

，另一个用于

日志

，并且似乎可以工作。VBA似乎无法在一条语句中创建嵌套目录？我必须说，我很惊讶VBA本身没有足够的智能来创建父目录…我喜欢使用文件系统对象而不是内置的VBA文件处理+1.

Function CreateFolderRecursive(path As String) As Boolean
    Static FSO As FileSystemObject
 
    'Initialize FSO variable if not already setup
    If FSO Is Nothing Then Set lFSO = New FileSystemObject

    'Is the path paramater populated
    If Len(path) = 0 Then
      CreateFolderRecursive = False
      Exit Function
    End If

    'If the path exists as a file, the function fails.
    If FSO.FileExists(path) Then
        CreateFolderRecursive = False
        Exit Function
    End If
 
    'If the path already exists as a folder, don't do anything and return success.
    If FSO.FolderExists(path) Then
        CreateFolderRecursive = True
        Exit Function
    End If
 
    'recursively create the parent folder, then if successful create the top folder.
    If CreateFolderRecursive(FSO.GetParentFolderName(path)) Then
        If FSO.CreateFolder(path) Is Nothing Then
            CreateFolderRecursive = False
        Else
           CreateFolderRecursive = True
        End If
    Else
        CreateFolderRecursive = False
    End If
End Function