Create Folder and Subfolders from the Cell

A

Atlok

New Member
Joined
Jul 28, 2015
Messages
27
Hello friends,

I am trying to create folders and subfolders from the cells by using VBA code.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]France[/TD]
[TD]Paris[/TD]
[TD]Nice[/TD]
[TD]Marseille[/TD]
[TD]Lyon[/TD]
[TD]Nantes[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]UK[/TD]
[TD]London[/TD]
[TD]Manchester[/TD]
[TD]Liverpool[/TD]
[TD]Oxford[/TD]
[TD]Preston[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Italy[/TD]
[TD]Milan[/TD]
[TD]Naples[/TD]
[TD]Rome[/TD]
[TD]Turin[/TD]
[TD]Genoa[/TD]
[/TR]
</tbody>[/TABLE]


Please find the code I tried to use below:

Code: 
Sub CreateFolderStructure()    For Each objRow In UsedRange.Rows
        strFolders = "C:\Users\USERID\Desktop\newnew"
        For Each ObjCell In objRow.Cells
            strFolders = strFolders & "\" & ObjCell
        Next
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next
End Sub

When I run the code, the following things created:


  • C:\Users\USERID\Desktop\newnew\France\Paris\Nice\Marseille\Lyon\Nantes
  • C:\Users\USERID\Desktop\newnew\Italy\Milan\Naples\Rome\Turin\Genoa
  • C:\Users\USERID\Desktop\newnew\UK\London\Manchester\Liverpool\Oxford\Preston

Instead of that, I want this thing to happen:


  • C:\Users\USERID\Desktop\newnew\France\Paris
  • C:\Users\USERID\Desktop\newnew\France\Nice
  • C:\Users\USERID\Desktop\newnew\France\Marseille
  • C:\Users\USERID\Desktop\newnew\France\Lyon
  • C:\Users\USERID\Desktop\newnew\France\Nantes
  • C:\Users\USERID\Desktop\newnew\Italy\Milan
  • C:\Users\USERID\Desktop\newnew\Italy\Naples
  • C:\Users\USERID\Desktop\newnew\Italy\Rome
  • C:\Users\USERID\Desktop\newnew\Italy\Turin
  • C:\Users\USERID\Desktop\newnew\Italy\Genoa
  • C:\Users\USERID\Desktop\newnew\UK\London
  • C:\Users\USERID\Desktop\newnew\UK\\Manchester
  • C:\Users\USERID\Desktop\newnew\UK\\Liverpool
  • C:\Users\USERID\Desktop\newnew\UK\\Oxford
  • C:\Users\USERID\Desktop\newnew\UK\\Preston

How can I do that? By the way, if you want to change the whole formula, please feel free to change. I will apply it for more than 250 cells.
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Hi there I think you are saying column A will always be the first subfolder, in which case you just need to add another loop into your macro:

Sub CreateFolders
strFolders = "C:\Users\USERID\Desktop\newnew"
s=1
Do until Cells(s,1) = vbnullstring
t=2
Do until Cells(s,t) = vbnullstring
File = strFolders &"\" & Cells(s,1)&"\"&Cells(s,t)
MkDir File
t=t+1
Loop
s=s+1
Loop
 
Upvote 0
Sorry just realized you'll need to add a MKDir in before entering the t loop as well to create the column A folder first... new code would be

s = 1
Do Until Cells(s, 1) = vbNullString
file = strFolders & "\" & Cells(s, 1)
MkDir file
t = 2
Do Until Cells(s, t) = vbNullString
file = strFolders & "\" & Cells(s, 1) & "\" & Cells(s, t) & "\"
If Len(Dir(file, vbDirectory)) = 0 Then
MkDir file
End If
t = t + 1
Loop
s = s + 1
Loop
 
Upvote 0
DebugGalpin said:
Sorry just realized you'll need to add a MKDir in before entering the t loop as well to create the column A folder first... new code would be

s = 1
Do Until Cells(s, 1) = vbNullString
file = strFolders & "\" & Cells(s, 1)
MkDir file
t = 2
Do Until Cells(s, t) = vbNullString
file = strFolders & "\" & Cells(s, 1) & "\" & Cells(s, t) & "\"
If Len(Dir(file, vbDirectory)) = 0 Then
MkDir file
End If
t = t + 1
Loop
s = s + 1
Loop
Click to expand...

This is what I exactly want! Thank you DebugGalpin! If I want to create one more subfolder for all of them, how can I do that?

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]G[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]France[/TD]
[TD]Paris[/TD]
[TD]Nice[/TD]
[TD]Marseille[/TD]
[TD]Lyon[/TD]
[TD]Nantes[/TD]
[TD]Streets[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]UK[/TD]
[TD]London[/TD]
[TD]Manchester[/TD]
[TD]Liverpool[/TD]
[TD]Oxford[/TD]
[TD]Preston[/TD]
[TD]Streets[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Italy[/TD]
[TD]Milan[/TD]
[TD]Naples[/TD]
[TD]Rome[/TD]
[TD]Turin[/TD]
[TD]Genoa

[/TD]
[TD]Streets[/TD]
[/TR]
</tbody>[/TABLE]


Input should be look like:


  • C:\Users\USERID\Desktop\newnew\France\Paris
  • C:\Users\USERID\Desktop\newnew\France\Paris\Streets
  • C:\Users\USERID\Desktop\newnew\France\Nice
  • C:\Users\USERID\Desktop\newnew\France\Nice\Streets
  • C:\Users\USERID\Desktop\newnew\France\Marseille
  • C:\Users\USERID\Desktop\newnew\France\Marseille\Streets
  • C:\Users\USERID\Desktop\newnew\France\Lyon
  • C:\Users\USERID\Desktop\newnew\France\Lyon\Streets
  • C:\Users\USERID\Desktop\newnew\France\Nantes
  • C:\Users\USERID\Desktop\newnew\France\Nantes\Streets
  • C:\Users\USERID\Desktop\newnew\Italy\Milan
  • C:\Users\USERID\Desktop\newnew\Italy\Milan\Streets
  • C:\Users\USERID\Desktop\newnew\Italy\Naples
  • C:\Users\USERID\Desktop\newnew\Italy\Naples\Streets
  • C:\Users\USERID\Desktop\newnew\Italy\Rome
  • C:\Users\USERID\Desktop\newnew\Italy\Rome\Streets
  • C:\Users\USERID\Desktop\newnew\Italy\Turin
  • C:\Users\USERID\Desktop\newnew\Italy\Turin\Streets
  • C:\Users\USERID\Desktop\newnew\Italy\Genoa
  • C:\Users\USERID\Desktop\newnew\Italy\Genoa\Streets
  • C:\Users\USERID\Desktop\newnew\UK\London
  • C:\Users\USERID\Desktop\newnew\UK\London\Streets
  • C:\Users\USERID\Desktop\newnew\UK\\Manchester
  • C:\Users\USERID\Desktop\newnew\UK\\Manchester\Streets
  • C:\Users\USERID\Desktop\newnew\UK\\Liverpool
  • C:\Users\USERID\Desktop\newnew\UK\\Liverpool\Streets
  • C:\Users\USERID\Desktop\newnew\UK\\Oxford
  • C:\Users\USERID\Desktop\newnew\UK\\Oxford\Streets
  • C:\Users\USERID\Desktop\newnew\UK\\Preston
  • C:\Users\USERID\Desktop\newnew\UK\\Preston\Streets

Thanks again.
 
Upvote 0
It is easier than I think. :stickouttounge:

For ones who might need same thing in the future, I am writing the formula:

Code: 
Sub CreateFolders()strFolders = "C:\Users\USERID\Desktop\newnew"
s = 1
Do Until Cells(s, 1) = vbNullString
file = strFolders & "\" & Cells(s, 1)
MkDir file
t = 2
Do Until Cells(s, t) = vbNullString
file = strFolders & "\" & Cells(s, 1) & "\" & Cells(s, t) & "\"
If Len(Dir(file, vbDirectory)) = 0 Then
MkDir file
End If
t = t + 1
file2 = file & "\" & Cells(t, 7)
MkDir file2
Loop
s = s + 1
Loop
End Sub
 
Upvote 0
Guys, I am trying to do one more thing but I could not do it up to now, please help me:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]G[/TD]
[TD="align: center"]H[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]France[/TD]
[TD]Cities[/TD]
[TD]Paris[/TD]
[TD]Nice[/TD]
[TD]Marseille[/TD]
[TD]Lyon[/TD]
[TD]Nantes[/TD]
[TD]Streets[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]UK[/TD]
[TD]Cities[/TD]
[TD]London[/TD]
[TD]Manchester[/TD]
[TD]Liverpool[/TD]
[TD]Oxford[/TD]
[TD]Preston[/TD]
[TD]Streets[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Italy[/TD]
[TD]Cities[/TD]
[TD]Milan[/TD]
[TD]Naples[/TD]
[TD]Rome[/TD]
[TD]Turin[/TD]
[TD]Genoa[/TD]
[TD]Streets[/TD]
[/TR]
</tbody>[/TABLE]


  1. Column A is Main Folder
  2. Column B is subfolder of Column A
  3. Column C, D, E, F, G are subfolder of Column B
  4. Column H is subfolder of Column C, D, E, F and G.

Output should be look like:


  • C:\Users\USERID\Desktop\newnew\France
  • C:\Users\USERID\Desktop\newnew\UK
  • C:\Users\USERID\Desktop\newnew\Italy
  • C:\Users\USERID\Desktop\newnew\France\Cities
  • C:\Users\USERID\Desktop\newnew\UK\Cities
  • C:\Users\USERID\Desktop\newnew\Italy\Cities
  • C:\Users\USERID\Desktop\newnew\France\Cities\Paris
  • C:\Users\USERID\Desktop\newnew\France\Cities\Paris\Streets
  • C:\Users\USERID\Desktop\newnew\France\Cities\Nice
  • C:\Users\USERID\Desktop\newnew\France\Cities\Nice\Streets
  • C:\Users\USERID\Desktop\newnew\France\Cities\Marseille
  • C:\Users\USERID\Desktop\newnew\France\Cities\Marseille\Streets
  • C:\Users\USERID\Desktop\newnew\France\Cities\Lyon
  • C:\Users\USERID\Desktop\newnew\France\Cities\Lyon\Streets
  • C:\Users\USERID\Desktop\newnew\France\Cities\Nantes
  • C:\Users\USERID\Desktop\newnew\France\Cities\Nantes\Streets
  • C:\Users\USERID\Desktop\newnew\Italy\Cities\Milan
  • C:\Users\USERID\Desktop\newnew\Italy\Cities\Milan\Streets
  • C:\Users\USERID\Desktop\newnew\Italy\Cities\Naples
  • C:\Users\USERID\Desktop\newnew\Italy\Cities\Naples\Streets
  • C:\Users\USERID\Desktop\newnew\Italy\Cities\Rome
  • C:\Users\USERID\Desktop\newnew\Italy\Cities\Rome\Streets
  • C:\Users\USERID\Desktop\newnew\Italy\Cities\Turin
  • C:\Users\USERID\Desktop\newnew\Italy\Cities\Turin\Streets
  • C:\Users\USERID\Desktop\newnew\Italy\Cities\Genoa
  • C:\Users\USERID\Desktop\newnew\Italy\Genoa\Streets
  • C:\Users\USERID\Desktop\newnew\UK\Cities\London
  • C:\Users\USERID\Desktop\newnew\UK\Cities\London\Streets
  • C:\Users\USERID\Desktop\newnew\UK\Cities\Manchester
  • C:\Users\USERID\Desktop\newnew\UK\Cities\Manchester\Streets
  • C:\Users\USERID\Desktop\newnew\UK\Cities\Liverpool
  • C:\Users\USERID\Desktop\newnew\UK\Cities\Liverpool\Streets
  • C:\Users\USERID\Desktop\newnew\UK\Cities\Oxford
  • C:\Users\USERID\Desktop\newnew\UK\Cities\Oxford\Streets
  • C:\Users\USERID\Desktop\newnew\UK\Cities\Preston
  • C:\Users\USERID\Desktop\newnew\UK\Cities\Preston\Streets

Thanks again.
 
Last edited:
Upvote 0
Try this:
Code: 
Public Sub Create_Folder_Tree()

    Dim root As String, r As Long, c As Long, path As String, city As String
    
    root = "C:\Users\USERID\Desktop"   'no trailing "\"
    
    r = 1
    Do Until Cells(r, 1).Value = ""
        path = CreateFolder(root, Cells(r, 1).Value)
        path = CreateFolder(path, Cells(r, 2).Value)
        For c = 3 To 7
            city = CreateFolder(path, Cells(r, c).Value)
            CreateFolder city, Cells(r, 8).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
 
Upvote 0
DebugGalpin said:
Hi there I think you are saying column A will always be the first subfolder, in which case you just need to add another loop into your macro:

Sub CreateFolders
strFolders = "C:\Users\USERID\Desktop\newnew"
s=1
Do until Cells(s,1) = vbnullstring
t=2
Do until Cells(s,t) = vbnullstring
File = strFolders &"\" & Cells(s,1)&"\"&Cells(s,t)
MkDir File
t=t+1
Loop
s=s+1
Loop
Click to expand...
Dear Sir,
This is my excel:
Sr.No.Total Link loanUnique IDLoan_NoLink Loan No. 2Link Loan No. 3Link Loan No. 4
84981482917473991313228655270732989781
104980889798653243712775132902111161743
125244446477143
2193535046431728
3298088238386959
4393550511282887841610014249675
5398167592531911234383713167967
63101769291364074234717676170740
73101778451329260292504683591255
9398993331336142519318804538703

Unique ID is my main Folder - Loan_No, Link Loan No. 2, Link Loan No. 3 & Link Loan No. 2 are subfolders in Unique ID Folder.

I need Path of Folders to be: C:\Users\Admin\Dropbox\poonam\(Insert Unique ID Folder)\(subfolder name)

Can you please help me with Macro, as i am new to excel so i am not understanding the macro given in parts in this conversation.

Please reply as soon as possible.

Thank you
Poonam
 
Upvote 0
poonamSS said:
I need Path of Folders to be: C:\Users\Admin\Dropbox\poonam\(Insert Unique ID Folder)\(subfolder name)

Can you please help me with Macro, as i am new to excel so i am not understanding the macro given in parts in this conversation.
Click to expand...
I think it's best if you start a new thread because your request is different to the OP's.
 
Upvote 0
Dear Sir,
This is my excel:
Sr.No.Total Link loanUnique IDLoan_NoLink Loan No. 2Link Loan No. 3Link Loan No. 4
84981482917473991313228655270732989781
104980889798653243712775132902111161743
125244446477143
2193535046431728
3298088238386959
4393550511282887841610014249675
5398167592531911234383713167967
63101769291364074234717676170740
73101778451329260292504683591255
9398993331336142519318804538703


Unique ID is my main Folder - Loan_No, Link Loan No. 2, Link Loan No. 3 & Link Loan No. 2 are subfolders in Unique ID Folder.

I need Path of Folders to be: C:\Users\Admin\Dropbox\poonam\(Insert Unique ID Folder)\(subfolder name)

Can you please help me with Macro, as i am new to excel so i am not understanding the macro given in parts in this conversation.

Please reply as soon as possible.

Thank you
Poonam
John_w said:
I think it's best if you start a new thread because your request is different to the OP's.
Click to expand...
thank you for prompt reply. My query is exactly same.
This how when u apply the above VBA folders turn out to be
  • C:\Users\USERID\Desktop\newnew\France\Paris
  • C:\Users\USERID\Desktop\newnew\France\Nice
  • C:\Users\USERID\Desktop\newnew\France\Marseille
  • C:\Users\USERID\Desktop\newnew\France\Lyon
  • C:\Users\USERID\Desktop\newnew\France\Nantes
In my case
C:\Users\Admin\Dropbox\poonam\9814829\1747399
C:\Users\Admin\Dropbox\poonam\9814829\13132286
C:\Users\Admin\Dropbox\poonam\9814829\5527073
C:\Users\Admin\Dropbox\poonam\9814829\2989781

So basically in 1 folder 4 subfolder will be made and so on.

So it’s the same situation, only if you can give me entire VBA as one. Will be helpful, so can just copy and paste.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Creating multiple child folders under a parent folder using VBA
Replies
4
Views
7K
John_w
J
D
  • Question Question
Cascading dropdown lists from dynamic ranges
Replies
4
Views
3K
Andrew Poulsom
Andrew Poulsom

Forum statistics

Threads
1,223,248
Messages
6,171,021
Members
452,374
Latest member
keccles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top