Solved How can I create several folders directories from Excel?

September 30, 2017 at 02:02:42
Specs: Windows 7
I want to create many similar folders and subfolders from excel data.

One row of my data in excel looks like this:
Number 1
Name 1
Number 2
Name 3.1
Name 3.2
Name 3.3

Number 1 and Number 2 changes with each subset, while names stay the same. I would like to generate a set of folders looking like this:
c:Number 1
---Name 1
----Number 2
-----Name 3.1
-----Name 3.2
-----Name 3.3

See More: How can I create several folders directories from Excel?

Reply ↓  Report •

October 2, 2017 at 00:39:30
✔ Best Answer
You can use the code below to create your folder structure. Please look at my example below of how you need to structure your worksheet in order for the code to create your structure.

             A                     B                    C                  D                  E 
1           C:\   
2                           Root Folder           
3                                                        Number1               
4                                                                           Name1
5                                                        Number2
6                                                                           Name3.1
7                                                                           Name3.2
8                                                                           Name3.3

The code will name the following folder structure

C:\Root Folder\Number1\Name1
C:\Root Folder\Number2\Name3.1
C:\Root Folder\Number2\Name3.2
C:\Root Folder\Number2\Name3.3



Sub CreateFolders()

    Dim r As Integer, c As Integer      'row, column indexes
    Dim home As Range
    Dim rng As Range                    'the current cell
    Dim done As Boolean
    Dim path As New List
    r = 0
    c = 0
    done = False
    Set home = ActiveSheet.Range("B2")
    Set rng = home
    path.Add (rng.Value)            'Root
    Do Until done
        Call NodeAction(r, c, rng.Value, path)
        r = r + 1
        c = c + 1
        Set rng = home.Offset(r, c)            'walk down-right
        path.Add (rng.Value)
        Do While IsEmpty(rng) And c > 0         'walk left
            c = c - 1
            Set rng = home.Offset(r, c)
            path.Remove                         'last element of path
            If Not path.IsEmpty Then path.SetLast (rng.Value)
        If c = 0 Then done = True
End Sub

Sub NodeAction(r As Integer, c As Integer, val As String, path As List)

    On Error Resume Next
    Dim pathstring As String
    pathstring = path.ToString

    Debug.Print val; " : "; pathstring
    If Not path.IsEmpty Then MkDir (Range("A1") + pathstring)
End Sub

CLASS (List)

Option Explicit

Dim liHead As ListItem
Dim liTail As ListItem

Dim licount As Integer

Const separator As String = "/"

Public Property Get Count() As Integer
    Count = licount
End Property

Function IsEmpty() As Boolean
    IsEmpty = (liHead Is Nothing)
End Function

Function First() As Variant
        'Pre: Not IsEmpty
    First = liHead.Value
End Function

Function Last() As Variant
        'Pre: Not IsEmpty
    Last = liTail.Value
End Function

Sub SetLast(val)
        'Pre: Not IsEmpty
    liTail.Value = val
End Sub

Private Function NthItem(n As Integer) As ListItem
    Dim litem As ListItem
    Dim i As Integer
    Set litem = liHead
    i = 1
    Do Until i = n
        Set litem = litem.NextItem
        i = i + 1
    Set NthItem = litem

End Function

Function GetNth(n As Integer) As Variant
        'Pre: n in range
    GetNth = NthItem(n).Value
End Function

Sub SetNth(n As Integer, val)
        'Pre: n in range
    NthItem(n).Value = val
End Sub

Sub Add(val)
    Dim oldtail
    Dim newitem As New ListItem
    newitem.Value = val
    If IsEmpty Then
        Set liHead = newitem
        Set oldtail = liTail
        Set oldtail.NextItem = newitem
    End If
    Set liTail = newitem
    licount = licount + 1

End Sub

Sub Remove()

    Dim newlast As ListItem
    Dim oldcount As Integer
    oldcount = licount
    If oldcount > 1 Then
        Set newlast = NthItem(licount - 1)
        Set newlast.NextItem = Nothing
        Set liTail = newlast
        licount = licount - 1
    ElseIf oldcount = 1 Then
        Set liHead = Nothing
        Set liTail = Nothing
        licount = 0
    ElseIf oldcount = 0 Then
        'Do nothing
    End If
End Sub

Function ToString() As String
    ToString = ""
    Dim i As Integer
    For i = 1 To licount
        ToString = ToString & separator & GetNth(i)
End Function

CLASS (ListItem)

Option Explicit

Public Value As Variant
Public NextItem As ListItem

Ensure you name the classes appropriately, List and ListItem otherwise there will be errors

message edited by AlwaysWillingToLearn

Reply ↓  Report •
Related Solutions

Ask Question