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 •

#1
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


CODE

MODULE

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
    
    Worksheets(1).Activate
    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)
        Loop
        
        If c = 0 Then done = True
        
    Loop
    
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
    Loop
    
    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
    Else
        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)
    Next
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