vba 从电子表格数据创建文件夹层次结构
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/10093983/
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
Create folder hierarchy from spreadsheet data
提问by toolshed
I have several spreadsheets with data organized from left to right which I would like to create folders from. Every record is complete with no blanks unless that is the end of the row, so I am shooting for something the following:
我有几个电子表格，其中的数据从左到右组织，我想从中创建文件夹。每条记录都是完整的，没有空白，除非那是行的末尾，所以我正在拍摄以下内容：
Col1 Col2 Col3
------ ------ ------
Car Toyota Camry
Car Toyota Corolla
Truck Toyota Tacoma
Car Toyota Yaris
Car Ford Focus
Car Ford Fusion
Truck Ford F150
Car
Toyota
Camry
Corolla
Yaris
Ford
Focus
Fusion
Truck
Toyota
Tacoma
Ford
F-150
...
The only caveat to this would be that I have about 15 columns, and some of the entries end at column 3 or 4, and so only those folders need to be created.
唯一需要注意的是，我有大约 15 列，有些条目在第 3 或 4 列结束，因此只需要创建这些文件夹。
Can anyone help with this request? I'm no stranger to programming, but I'm still pretty new with VBA.
任何人都可以帮助处理这个请求吗？我对编程并不陌生，但我对 VBA 还是很陌生。
Thanks!
谢谢！
回答by Tim Williams
Sub Tester()
Const ROOT_FOLDER = "C:\TEMP\"
Dim rng As Range, rw As Range, c As Range
Dim sPath As String, tmp As String
Set rng = Selection
For Each rw In rng.Rows
sPath = ROOT_FOLDER
For Each c In rw.Cells
tmp = Trim(c.Value)
If Len(tmp) = 0 Then
Exit For
Else
sPath = sPath & tmp & "\"
If Len(Dir(sPath, vbDirectory)) = 0 Then MkDir sPath
End If
Next c
Next rw
End Sub
回答by Leandro Jacques
I found a much better way of doing the same, less code, much more efficient. Note that the """" is to quote the path in case it contains blanks in a folder name. Command line mkdir creates any intermediary folder if necessary to make the whole path exist. So all you have to do is to concatenate the cells using \ as separator to specify your path and then
我找到了一种更好的方法来做同样的事情，代码更少，效率更高。请注意，"""" 用于引用路径，以防文件夹名称中包含空格。如果需要使整个路径存在，命令行 mkdir 会创建任何中间文件夹。所以你所要做的就是使用 \ 作为分隔符连接单元格来指定你的路径，然后
If Dir(YourPath, vbDirectory) = "" Then
Shell ("cmd /c mkdir """ & YourPath & """")
End If
回答by Joseph
Try this out. It assumes you start at column "A" and it also starts the directory in C:\ (using the sDir variable). Just change "C:\" to whatever you want your base point to be if you need to.
试试这个。它假设您从“A”列开始，并且还在 C:\ 中启动目录（使用 sDir 变量）。如果需要，只需将“C:\”更改为您想要的基点即可。
Option Explicit
Sub startCreating()
Call CreateDirectory(2, 1)
End Sub
Sub CreateDirectory(ByVal row As Long, ByVal col As Long, Optional ByRef path As String)
If (Len(ActiveSheet.Cells(row, col).Value) <= 0) Then
Exit Sub
End If
Dim sDir As String
If (Len(path) <= 0) Then
path = ActiveSheet.Cells(row, col).Value
sDir = "C:\" & path
Else
sDir = path & "\" & ActiveSheet.Cells(row, col).Value
End If
If (FileOrDirExists(sDir) = False) Then
MkDir sDir
End If
If (Len(ActiveSheet.Cells(row, col + 1).Value) <= 0) Then
Call CreateDirectory(row + 1, 1)
Else
Call CreateDirectory(row, col + 1, sDir)
End If
End Sub
' Function thanks to: http://www.vbaexpress.com/kb/getarticle.php?kb_id=559
Function FileOrDirExists(PathName As String) As Boolean
'Macro Purpose: Function returns TRUE if the specified file
' or folder exists, false if not.
'PathName : Supports Windows mapped drives or UNC
' : Supports Macintosh paths
'File usage : Provide full file path and extension
'Folder usage : Provide full folder path
' Accepts with/without trailing "\" (Windows)
' Accepts with/without trailing ":" (Macintosh)
Dim iTemp As Integer
'Ignore errors to allow for error evaluation
On Error Resume Next
iTemp = GetAttr(PathName)
'Check if error exists and set response appropriately
Select Case Err.Number
Case Is = 0
FileOrDirExists = True
Case Else
FileOrDirExists = False
End Select
'Resume error checking
On Error GoTo 0
End Function
