创建电子表格数据文件夹层次(Create folder hierarchy from spreads

我有几个电子表格与左边，我想从创建文件夹权组织的数据。 每一个记录是完全不带空格除非这是该行的末尾，所以我拍摄了下面的内容：

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:

我发现做同样的，更少的代码的一种更好的方式，更有效。 请注意，“”，“”是引用的情况下，它包含了一个文件夹名称空白路径。 如果必要的话命令行的mkdir创建任何中介的文件夹，使整个路径存在。 因此，所有你需要做的就是使用\作为分隔符来指定路径，然后以连接细胞

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

Answer 3:

尝试了这一点。 它假定你开始在列“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

文章来源: Create folder hierarchy from spreadsheet data