Create multiple folders with Excel macros using VBA

Question

I need help creating a macros for creating multiple folders in User Desktop MRO_FOLDERS subfolder.

I have column Main Folder with list of main folders. In each Main Folder I need to create all subfolders mentioned in column SubFolder level 1

For example: for Folder A I need to create

desktop\Folder A\SUB1
desktop\Folder A\SUB2
desktop\Folder A\SUB3

My knowledge of programming is poor. Please see my current version of script below

Sub MakeDirs()
Dim Fldrpath As String
    Fldrpath = Environ$("USERPROFILE") & "\Desktop\MRO_FOLDERS\"
If Dir(Fldrpath, vbDirectory) = "" Then
MkDir Fldrpath
End If
For Each cell In Selection
 MkDir Environ$("USERPROFILE") & "\Desktop\MRO_FOLDERS\" & cell.Value
 MkDir Environ$("USERPROFILE") & "\Desktop\MRO_FOLDERS\" & cell.Value & "\GANTT Charts"
 MkDir Environ$("USERPROFILE") & "\Desktop\MRO_FOLDERS\" & cell.Value & "\Induction"
 MkDir Environ$("USERPROFILE") & "\Desktop\MRO_FOLDERS\" & cell.Value & "\Photos"
 MkDir Environ$("USERPROFILE") & "\Desktop\MRO_FOLDERS\" & cell.Value & "\Planning Meetings"
Next cell
 'Display Message
    MsgBox "New folder >MRO_FOLDERS< have been created successfully on your Desktop !", vbInformation, "VBAF1"

End Sub

Which does the job but I need to edit the macro if I want to add or remove SubFolder Level 1

I would say that you asked the question properly, but you didn't back it up with any code, like the last time so people couldn't see how much effort you put into this. — VBasic2008

Tim Williams Tim Williams · Accepted Answer · 2020-07-20T21:59:30

Something like this:

Sub MakeDirs()
    Dim Fldrpath As String, ws As Worksheet, cell As Range, sf As Range
    
    Set ws = ActiveSheet
    
    Fldrpath = Environ$("USERPROFILE") & "\Desktop\MRO_FOLDERS\"
    If Dir(Fldrpath, vbDirectory) = "" Then
        MkDir Fldrpath
    End If
    
    'assuming you don't have that second list in Col A
    For Each cell In ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Cells
        MkDir Fldrpath & cell.Value
        'create subfolders
        For Each sf In ws.Range("B2:B" & ws.Cells(Rows.Count, 2).End(xlUp).Row).Cells
            MkDir Fldrpath & cell.Value & "\" & sf.Value
        Next sf
    Next cell
    
    'Display Message
    MsgBox "New folder 'MRO_FOLDERS' has been created successfully on your Desktop !", _
                vbInformation, "VBAF1"

End Sub

Create multiple folders with Excel macros using VBA

1 Answers