FileSystemObject.CreateFolder用于创建目录和子目录

Question

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

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

我正在尝试创建嵌套目录.在这种情况下,该DataEntry目录将不存在,所以基本上我想创建2个目录,DataEntry\logs下C:\Users\<username>

如果我输入命令提示符,我可以创建该目录而mkdir没有任何问题.但是,我根本无法让VBA创建该文件夹,我得到:

Run-time error '76':

Path not found                        

我使用的是Excel VBA 2007/2010

Answer 1

需要一次创建一个文件夹.您可以使用这样的代码来执行此操作:

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

Answer 2

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