我想用以下代码创建一个目录和一个子目录:
Public fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
fso.CreateFolder ("C:\Users\<my_username>\DataEntry\logs")
我正在尝试创建嵌套目录。在这种情况下,DataEntry
目录将不存在,所以基本上我想在DataEntry\logs
下创建2个目录C:\Users\<username>
如果我输入命令提示符,我可以使用mkdir
创建该目录而不会出现任何问题。但是,我根本无法让VBA创建该文件夹而且我得到了:
Run-time error '76':
Path not found
我正在使用Excel VBA 2007/2010
答案 0 :(得分:6)
需要一次创建一个文件夹。您可以使用这样的代码来执行此操作:
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
答案 1 :(得分:4)
这是我使用的功能:
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
答案 2 :(得分:0)
同意 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