VBA to create Folder Tree - Sub and Super Sub Folders

[Mahesh Babu]

Hello Experts,

List of activities in Column 'A' should be my 'Parent Folder' which are unique.

I have listed sub and super sub folders which are common for all the unique 'Parent Folders' created above.

Looking for a VB script where i can accomplish the job in one click.



I'm looking for output which should look as below:



Appreciate your help.

 

[Marc L]

Hello, how exactly is the worksheet before to launch the VBA procedure and how it must be exactly after ?​

Is the purpose to scan all subfolders from a main path or only the subfolders in column A ?​

Do you really need such colored layout ?​

Which OS, Windows only ?​

​

 

[Mahesh Babu]

Hi,

Apologies for the confusion.

1. The actual ask is to create unique folders based on the cell values in column A (starts from A2, A3 ....)
2. Columns 'B' till column 'G' are the sub folders and super sub folders of the Parent folders (created as part of column A) which are common.
3. Column I has the path where the folder should get created (which can directly given in the code as well instead from cell value)
4. The output should be like below in the path (which we give in the code or from cell value in excel).
5. When i run the macro, below folder structure should be created for all the cells values in Column A
6. Attached excel is just an input file to create the below folder structure.

Nothing to do with the colors in the excel (Thought it will be more clear if i differentiate, as it led to confusion, you can ignore the same). Every time data column in 'A' keeps changing. Rest of the columns data will be same. Attaching excel for your reference again.

I tried my best to be as clear as i can. Appreciate your help on the ask. Thank you !!

Note: To be precise, Main folder should be from 'Column A' which are unique, sub folders should be from column B till G which are common across all the Parent folders of Column A.




Currently i have macro, which will create the root folder (main folder) and 1 sub folder. But my requirement is to create Root folder with multi level sub folders.

>>> use code - tags <<<

Public Sub Create_Folder_Tree()

    Dim root As String, r As Long, c As Long, path As String, city As String
 
    root = "C:\Users\email\OneDrive\Desktop\Test"   'no trailing " \ ""
 
    r = 2
    Do Until Cells(r, 2).Value = ""
        path = CreateFolder(root, Cells(r, 1).Value)
        'path = CreateFolder(path, Cells(r, 8).Value)
        For c = 2 To 7
            folder = CreateFolder(path, Cells(r, c).Value)
            CreateFolder folder, Cells(r, 8).Value
            'CreateFolder folder, Cells(r, 9).Value
        Next
        r = r + 1
    Loop
 
End Sub

Private Function CreateFolder(ParamArray folders() As Variant) As String
    CreateFolder = Join(folders, "\")
    If Dir(CreateFolder, vbDirectory) = "" Then MkDir CreateFolder
End Function

 

[Marc L]

Which OS, Windows only ?

 

[AlanSidman]

crosspost: https://www.mrexcel.com/board/threads/folder-tree-using-vba.1228851/

 

[vletm]

Mahesh Babu / Prince27
Would You reread Forum rules, please?

Site Rules - New Users - Please Read

Hi all, Welcome to the Chandoo.org Forums. Posting Rules & Etiquette The Chandoo.org Forums is a collaborative and happy place to learn and expand your Excel knowledge. The Chandoo.org Forums consist of several Sub-Forums based on the type of question/area of Excel you are interested in...

chandoo.org

• Cross-Posting. Generally, it is considered poor practice to cross post. That is to post the same question on several forums in the hope of getting a response quicker.
• If you do cross-post, please put that in your post.
• Also if you have cross-posted and get an Solution elsewhere, have the courtesy of posting the Solution here so other readers can learn from the answer also, as well as stopping people wasting their time on your answered question.

 

[Mahesh Babu]

Sure . Will refrain while posting next time as i did not had solution, just wanted to try here and it was important task for me to accomplish

Moderator note: Why did You ... delete it? ... and it was still there few minutes later.

 

[Mahesh Babu]

Yes, on Windows Desktop

 

[YasserKhalil]

Try this code

Sub Create_Folders_Tree()
    Dim ws As Worksheet, sParentFolder As String, sMainFolder As String, sMainFolderPath As String, lr As Long, i As Long, ii As Long, iii As Long
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    sParentFolder = ThisWorkbook.Path & "\All_Activities"
    CreateFolder sParentFolder
    For i = 2 To lr
        sMainFolder = ws.Cells(i, 1).Value
        sMainFolderPath = sParentFolder & "\" & sMainFolder
        CreateFolder sMainFolderPath
        For ii = 2 To 7
            With ws.Cells(1, ii)
                CreateFolder sMainFolderPath & "\" & .Value
                For iii = 2 To lr
                    If ws.Cells(iii, ii).Value = Empty Then GoTo Skipper
                    CreateFolder sMainFolderPath & "\" & .Value & "\" & ws.Cells(iii, ii).Value
Skipper:
                Next iii
            End With
        Next ii
    Next i
    MsgBox "Done", 64
End Sub

Private Sub CreateFolder(ByVal sFolderName As String)
    If Len(Dir(sFolderName, vbDirectory)) = 0 Then MkDir sFolderName
End Sub

 

[Marc L]

Hello Yasser !​

​

Rather than your 'Skipper' why not an efficient Exit For ?​

​

You have hardcoded the columns number to 7 but not sure it is always 7.​

​

Another way is to create each deeper path at once with the Windows function 'MakeSureDirectoryPathExists' …​

​

 

[Mahesh Babu]

Hello Yaseer,

Firstly, Thank you so much for your help with the above code.

However, under 'Activity 3' sub folder there are 5 super sub folders, but only 2 super sub folders are getting created. The above code is not working if the Sub Folders have more than 2 Super sub folders. Can you please look into and help me further.

 

[Marc L]

Should better work according to the CurrentRegion rather than on column A …​

​

 

[Mahesh Babu]

Can someone help me with revised code without dependent on column A,

1.Column 'A' is dynamic in nature which might have only 1 items or 10 item based on the need.
2. Where in columns 'B' till column 'G' are static data, which should be common for all the Items of column A (if it only 1 item or 10 items (main folders)

With the above code, if i have only 1 row item in column A, it is picking only 1 row item from columns B till G.

@ Marc L, @ YasserKhalil

Appreciate your help on the revised code.

 

[Marc L]

Without such wild cross posting you already had my version …​

​

As all is 'static' under Excel, in particular at the moment when launching any VBA procedure !​

As I can't reproduce this newer issue according to your 'static' post #3 attachment as post #9 code works as expected on my side !​

​

So the question is : did you test at least with exactly the same post #3 attachment​

or did you change the rules with another workbook not such 'static' but variable (as again dynamic is a no sense) ?​

​

 

[Mahesh Babu]

Kindly, ignore the post # 13, if i have confused you.

May be my bad. Let me rephrase my question/problem statement:

1. Yes i did try the above code (post #9), its working fine but with an issue.
2. Issue is as per above screen shot (post #3) and attached excel, Column A has 4 unique row items (Main/Parent folder which is working fine)
3. Column 'D' Activity 3 has 5 sub folders (but only 4 folders are getting created) because it is considering/depending on column A (which has only 4 row items) ideally should not be the case.
4. Irrespective of unique row items in column 'A', the sub and super sub folders appeared in column 'B till G' should get created. (which i have mentioned in post #3)
5. There is no change in the ask.

If column A has 5 row items, then only i am able to achieve the desired result as quoted above(Post #3)

Note: Sub and Super sub folders from Column B till G are common and should be created for all the unique row items of Column A ( whether it has 1 or 2 or 10 ..... row items)

Appreciate your help.

 

[Marc L]

As on my side I had only 4 sub folders in Activity 3, so weird …​

Anyway according to your post #3 static attachment a Windows only Excel basics formula VBA demonstration​

- notice as it is faster than the time necessary to release the mouse button when launching it​

so any message box is useless to indicate it is achieved but only in case of any error -​

to paste only to the top of a VBA module :​

Private Declare PtrSafe Function MakeSureDirectoryPathExists% Lib "imagehlp.dll" (ByVal DirPath$)

Sub Demo1()
  Const B = "&""\""", P = """D:\Tests4Noobs\Mahesh Babu\""&A"
    Dim L&, S$, C%, F$, T&, V, E%, R&
        L = Cells(Rows.Count, 1).End(xlUp).Row:  If L = 1 Then Beep: Exit Sub
        S = P & "2:A" & L
    For C = 2 To [A1].CurrentRegion.Columns.Count
           F = "&""\""&" & Cells(C).Address & B
           T = Cells(Rows.Count, C).End(xlUp).Row
        If T = 1 Then
            For Each V In Evaluate(S & F):  E = E + 1 - MakeSureDirectoryPathExists(V):  Next
        Else
                F = F & "&" & Cells(2, C).Address & ":" & Cells(T, C).Address & B
            For R = 2 To L
            For Each V In Evaluate(P & R & F)
                E = E + 1 - MakeSureDirectoryPathExists(V)
            Next V, R
        End If
    Next
        If E Then MsgBox "Errors : " & E, 48, "Deeper sub folders creation"
End Sub

Do you like it ? So thanks to click on bottom right Like !​

​

 

[Mahesh Babu]

Throwing error message

if possible upload you working file as well please.

 

[Marc L]

As it works a treat on my side since many years on dozen of Windows computers without such error so the bad is on your side …​

Delete the code, paste mine from my post then just update the path in P constant, nothing else !​

When you launch it, the activities worksheet must be active.​

If still the same error so what is the content of each variable ? …​

​