EXCEL VBA - 如果目录和文件夹不存在，则创建它们
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/42116735/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
EXCEL VBA - create directories and folders if they are not already there
提问by minnow1
I have a list of folder locations in column A that define the directory hierarchy I am trying to create (e.g. "C:\topFolder\nextFolder\lastFolder\). The code runs with no errors, but no folders are created. What am I doing wrong here?
我在 A 列中有一个文件夹位置列表，它定义了我要创建的目录层次结构（例如“C:\topFolder\nextFolder\lastFolder\”）。代码运行没有错误，但没有创建文件夹。我是什么这里做错了吗？
Sub newDestination()
Dim Path As Variant
Dim folderLevel As Variant
For Each Path In Sheet11.Range("A:A")
For Each folderLevel In Split(Path.Value, "\")
folderLevel = folderLevel & "\"
If Len(Dir(folderLevel, vbDirectory)) = 0 Then
MkDir folderLevel
End If
Next folderLevel
Next Path
End Sub
回答by cyboashu
You are creating orphan folders. mkdir "abc\" will create a folder named abc in the WorkBook's directory. If the workbook is not saved then this folder gets created in MyDocuments (most likey, depending on Excel's config).
您正在创建孤立文件夹。mkdir "abc\" 将在 WorkBook 的目录中创建一个名为 abc 的文件夹。如果未保存工作簿，则会在 MyDocuments 中创建此文件夹（最相似，取决于 Excel 的配置）。
You need to pass fully qalified path to create a folder at your desired location like "C:\Temp\abc\"
您需要传递完全合格的路径以在您想要的位置创建一个文件夹，例如“C:\Temp\abc\”
In your code the issue is with how you are running your for loop and passing the folder name.
在您的代码中，问题在于您如何运行 for 循环并传递文件夹名称。
This is how you need to do this:
这是您需要执行此操作的方式：
Sub test()
Dim strPath As String
Dim lCtr As Long
strPath = "C:\Temp\Parent\Child\ChildsChild"
arrpath = Split(strPath, "\")
strPath = arrpath(LBound(arrpath)) & "\"
For lCtr = LBound(arrpath) + 1 To UBound(arrpath)
strPath = strPath & arrpath(lCtr) & "\"
If Dir(strPath, vbDirectory) = "" Then
MkDir strPath
End If
Next
End Sub
