VBA - Create folders based on names on a column

This is a simple thing that sometimes we need to use. We have an Excel sheet that has a list of, for example, names in column A and we want to create folders for each of them on a disk. For that we can make a small VBA code to go through each of the rows on column A and create a folder with that name on the path that we specify on our code. To do that, I came up with this code:

Sub MakeFolders()
    Dim xdir As String
    Dim fso
    Dim lstrow As Long
    Dim i As Long
    Set fso = CreateObject("Scripting.FileSystemObject")
    lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 1 To lstrow
        'change the path on the next line where you want to create the folders
        xdir = "C:\" & Range("A" & i).Value
        If Not fso.FolderExists(xdir) Then
            fso.CreateFolder (xdir)
        End If
    Next
    Application.ScreenUpdating = True
End Sub

On this example, I will create the folders under C:\ If you want a different place, just change it on the code.

12 comentários:

Anonymous said...

What is the code for adding populated folders onto a folder called Research on the c drive?

jppinto said...

Just change this line of code for something like this:

xdir = "C:\Research" & Range("A" & i).Value

Anonymous said...

I tried this but this just makes a folder on my C Drive called Research plus the information in Collom A? Im looking for the collom A info to be put into a exsisting folder on the C Drive called Research.

Thanks for your help!

Anonymous said...

xdir = "C:\Research" & Range("A" & i).Value

need to be

xdir = "C:\Research\" & Range("A" & i).Value

To place the folders into research. Otherwise it will just create the folders in C:\ with a prefix of Research.

Source: Had this issue myself.

jppinto said...

That is correct. My mistake. Thanks for pointing it out.

Anonymous said...

How can you add a set of sub-folders to each folder? I've managed to get the above code to work for the first set of folders, but I need about 12 folders within each folder. All the sub-folders are the same & I have them on a list in column H at the top of the same sheet as the names of the first folders.

jppinto said...

Just add a second loop to create the sub folders. If you have the data on column H, on rows 1 to 12, use the code like this:

Dim i As Long
Dim j As Long
Set fso = CreateObject("Scripting.FileSystemObject")
lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To lstrow
For j = 1 To 12
'change the path on the next line where you want to create the folders
xdir = "C:\" & Range("H" & j).Value & Range("A" & i).Value
If Not fso.FolderExists(xdir) Then
fso.CreateFolder (xdir)
End If
Next j
Next i

Anonymous said...

This is great - just what I needed. but what is the change in code if I do not want to run this on the entire Column A but on a case by case basis (for example - 1st time, cell A1 / next time cell A5 etc)

Thanks in advance

Luke

Jackie Yunianto said...

hi, mr pinto,
ive just read your blog here, can what about if we want the folder created in same folder with the workbook that we open

Filipe said...

Hey Anonymous from 25/7/12 10:26 AM

To create a folder from a single cell value, try this:

____________________________
Sub MakeFolders()
Dim FldrName As String
On Error Resume Next
For i = 2 To 2
FldrName = Cells(3, i).Value
MkDir "C:\" & FldrName
Next i

End Sub
_____________________________

In this case, I created a folder based on the value of cell B3, that's why you see "For i = 2 To 2" (2 stands for B) and "Cells(3, i)"

All the best

Filipe Samora

LC said...

Hi,

I tried to use your code and adapt it that I have X numbers of parentfolders and each time 4 subfolders, type
c:\name1
c:\name1\subfolder1
c:\name1\subfolder2
c:\name1\subfolder3
c:\name1\subfolder4
c:\name2
c:\name2\subfolder1
c:\name2\subfolder2 ..... etc.

I tried to adapt the code as follows, but I do not reach my goal. Can anybody help ? Thanks.

Sub makedirectories()

Dim xdir As String
Dim fso
Dim lstrow As Long
Dim i As Long
Dim j As Long
Set fso = CreateObject("Scripting.FileSystemObject")
lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To lstrow
For j = 1 To 4
'change the path on the next line where you want to create the folders
xdir = "C:\Users\Luc\Documents\werkjes Cis\Klantenfiles\" _
& Range("B" & i + 1).Value & "\" & Range("Z" & j).Value
If Not fso.FolderExists(xdir) Then
fso.CreateFolder (xdir)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub

LC said...

Hi,

I tried to use your code and adapt it that I have X numbers of parentfolders and each time 4 subfolders, type
c:\name1
c:\name1\subfolder1
c:\name1\subfolder2
c:\name1\subfolder3
c:\name1\subfolder4
c:\name2
c:\name2\subfolder1
c:\name2\subfolder2 ..... etc.

I tried to adapt the code as follows, but I do not reach my goal. Can anybody help ? Thanks.

Sub makedirectories()

Dim xdir As String
Dim fso
Dim lstrow As Long
Dim i As Long
Dim j As Long
Set fso = CreateObject("Scripting.FileSystemObject")
lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To lstrow
For j = 1 To 4
'change the path on the next line where you want to create the folders
xdir = "C:\Users\Luc\Documents\werkjes Cis\Klantenfiles\" _
& Range("B" & i + 1).Value & "\" & Range("Z" & j).Value
If Not fso.FolderExists(xdir) Then
fso.CreateFolder (xdir)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub