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

需要一次创建一个文件夹。您可以使用如下代码来执行此操作：

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

同意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

我通常是这样做的：

Public Function FSOCreateFolder2(strPath As String) As Boolean
    Static FSO As New FileSystemObject
    If Not FSO.FolderExists(FSO.GetParentFolderName(strPath)) Then
        'walk back up until you find one that exists
        FSOCreateFolder2 FSO.GetParentFolderName(strPath)
    End If
    FSO.CreateFolder strPath
End Function

我更喜欢在递归函数之外检查参数和路径的存在性。