Erstellen Sie Ordnerhierarchie aus Tabellenkalkulationsdaten

Question

Ich habe mehrere Tabellen mit Daten von links nach rechts organisiert, aus denen ich Ordner erstellen möchte. Jeder Datensatz ist ohne Leerstellen vollständig, wenn dass das Ende der Reihe ist, so drehe ich für etwas, das die folgenden Schritte aus:

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

Die einzige Einschränkung dabei wäre, dass ich etwa 15 Spalten haben, und einige der Einträge enden in Spalte 3 oder 4 und so müssen nur diese Ordner erstellt werden.

Kann jemand mit dieser Bitte helfen? Ich bin nicht fremd beim Programmieren, aber ich bin immer noch ziemlich neu bei VBA.

Danke!

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

Probieren Sie es aus. Es wird davon ausgegangen, dass Sie bei Spalte "A" beginnen und es das Verzeichnis in C: \ (mithilfe der Variable SDir) ebenfalls startet. Ändern Sie einfach "C: \" zu dem, was Sie möchten, wenn Ihr Basispunkt benötigt wird.

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

fand ich einen viel besseren Weg, um den gleichen, weniger Code zu tun, viel effizienter. Beachten Sie, dass "" "den Pfad angeben soll, falls er Leerzeichen in einem Ordnernamen enthält. Befehlszeile mkdir erstellt ggf. einen Zwischenordner, um den gesamten Pfad zu erstellen. Alles, was Sie tun müssen, ist, die Zellen mit \ als Trennzeichen zu verketten, um Ihren Pfad anzugeben und dann