從電子表格數據創建文件夾層次

Question

我有幾個電子表格，數據從左到右排列，我想從中創建文件夾。每一個記錄是完全不帶空格除非這是該行的末尾，所以我拍攝的東西如下：

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列結束，因此只需要創建這些文件夾。

任何人都可以幫助這個請求嗎？我對編程並不陌生，但對於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：\中的目錄（使用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 

Answer 3

我發現做同樣的，更少的代碼的一種更好的方式，更有效。請注意，如果文件夾名稱中包含空格，「」「」將引用該路徑。命令行mkdir會根據需要創建任何中間文件夾，以使整個路徑存在。因此，您所要做的就是使用\作爲分隔符來連接單元格以指定您的路徑，然後

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