从电子表格数据创build文件夹层次结构

我有几个电子表格，数据从左到右，我想从中创build文件夹。 每个logging都是完整的，没有空白，除非这是行的末尾，所以我正在拍摄以下内容：

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 ... 

唯一需要注意的是我有大约15列，一些条目在第3或第4列结束，所以只有那些文件夹需要被创build。

任何人都可以帮助这个请求吗？ 我对编程并不陌生，但对于VBA我还是很新的。

谢谢！

Answer 1

 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 

Answer 2

试试这个。 它假定你从列“A”开始，它也启动C：\目录（使用sDirvariables）。 只要将“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 

Answer 3

我发现了一个更好的方法来做同样的事情，更less的代码，更有效率。 请注意，如果文件夹名称中包含空格，“”“将引用该path。 命令行mkdir创build任何中间文件夹，如果需要使整个path存在。 所以你所要做的就是用\作为分隔符连接单元格来指定你的path

 If Dir(YourPath, vbDirectory) = "" Then Shell ("cmd /c mkdir """ & YourPath & """") End If