Creating Windows Folders and Subfolders VBA Code Modification Help

[bellownc]

I found this post from earlier this year. I used it to create a folder and subfolder structure and it appeared to work well but was only able to go one subfolder level deep. In the below data set folders from Column B and folders for Column C were all created as subfolders of Column A. I want Column C to be a subfolder of Column B,

My format is :

Column A	Column B	Column C
FOLDER 1	folder 1.1	folder 1.1.1
FOLDER 1	folder 1.1	folder 1.1.2
FOLDER 1	folder 1.2	folder 1.2.1
FOLDER 1	folder 1.2	folder 1.2.2
FOLDER 2	folder 2.1	folder 2.1.1
FOLDER 2	folder 2.2	folder 2.2.1

to create a file structure in windows that looks like this:

I used this code:

Public Sub CreateFolderStructure2()

    Dim baseFolder As String
    Dim objRow As Range, c As Long
 
    baseFolder = "C:\path\to\base folder\"
    If Right(baseFolder, 1) <> "\" Then baseFolder = baseFolder & "\"
 
    For Each objRow In Worksheets("Sheet2").UsedRange.Rows
        For c = 2 To objRow.Cells.Count
            Shell "cmd /c md " & Chr(34) & baseFolder & objRow.Cells(1, 1) & "\" & objRow.Cells(1, c) & Chr(34)
        Next
    Next
 
End Sub

I would like to modify the above code to meet my needs but I am pretty new to this type of coding.
Any help that could be provided would be great.

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub bellownc()
   Dim Pth As String, FullPth As String
   Dim Cl As Range
   Dim i As Long
   
   Pth = "C:\MrExcel\"
   If Right(Pth, 1) <> "\" Then Pth = Pth & "\"
   With Sheets("Sheet2")
      For Each Cl In .Range("A2", .Range("A" & Rows.count).End(xlUp))
         FullPth = Pth & Cl.Value & "\"
         If Not FldrExists(FullPth) Then MkDir FullPth
         For i = 1 To .Cells(Cl.Row, Columns.count).End(xlToLeft).Column - 1
            FullPth = FullPth & Cl.Offset(, i).Value & "\"
            If Not FldrExists(FullPth) Then MkDir FullPth
         Next i
         FullPth = Pth
      Next Cl
   End With
End Sub
Function FldrExists(DirPth As String) As Boolean
   FldrExists = Dir(DirPth, vbDirectory) <> ""
End Function

 

[bellownc]

Hi & welcome to MrExcel.
How about

Sub bellownc()
   Dim Pth As String, FullPth As String
   Dim Cl As Range
   Dim i As Long
  
   Pth = "C:\MrExcel\"
   If Right(Pth, 1) <> "\" Then Pth = Pth & "\"
   With Sheets("Sheet2")
      For Each Cl In .Range("A2", .Range("A" & Rows.count).End(xlUp))
         FullPth = Pth & Cl.Value & "\"
         If Not FldrExists(FullPth) Then MkDir FullPth
         For i = 1 To .Cells(Cl.Row, Columns.count).End(xlToLeft).Column - 1
            FullPth = FullPth & Cl.Offset(, i).Value & "\"
            If Not FldrExists(FullPth) Then MkDir FullPth
         Next i
         FullPth = Pth
      Next Cl
   End With
End Sub
Function FldrExists(DirPth As String) As Boolean
   FldrExists = Dir(DirPth, vbDirectory) <> ""
End Function

Thanks. I will try this out and let you know. Appreciate it.

 

[Fluff]

Ok,

 

[bellownc]

Ok,

Sorry for the delay. Just finally got back to this work. It worked perfectly. Thank you so much.

 

[Fluff]

You're welcome & thanks for the feedback.