Multiple folders with subfolders

fgfdg456

New Member
Joined
Feb 25, 2023
Messages
2
Office Version
  1. 2021
Platform
  1. Windows
Hi im crap at VBA, but ive used a folder creator:
Sub MakeFolders()
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))
On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub

And found an old post Create a Directory with VBA explaining how to add in subfolders using:
Dim rngSubDir As Range, cell2 As Range
Dim dynPath2 As String
Set rngSubDir = Worksheets("Sheet1").Range("B2:C4") '//Range with subfolders

For Each cell In Rng
dynPath = baseBase & cell.Value
If Len(Dir(dynPath, vbDirectory)) = 0 Then
MkDir dynPath
End If
For Each cell2 In rngSubDir
dynPath2 = dynPath & cell2.Value
If Len(Dir(dynPath, vbDirectory)) = 0 Then
MkDir dynPath
End If
Next cell2
Next cell
With the explanation: If you want the same folders in every directory currently in the selection range you could place them in a separate range and For Each loop through them. By adding this and removing the for each loop in the sub.

BUT its not working for me. any idea how i can integrate/combine the two?
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
This procedure will create the folders referenced in column A.

It will create all of the folders in the path if they don't already exist.

1677406349801.png


VBA Code:
Public Sub subMakeFolders()
Dim arrFolders() As Variant
Dim i As Integer
Dim arrSplit() As String
Dim x As Integer
Dim strFolder As String

    arrFolders = Range("A2:A" & Range("A2").End(xlDown).Row)
        
    For i = LBound(arrFolders) To UBound(arrFolders)
        arrSplit = Split(arrFolders(i, 1), "\")
        strFolder = ""
        For x = LBound(arrSplit) To UBound(arrSplit)
            strFolder = strFolder & "\" & arrSplit(x)
            If x > 0 Then
                On Error Resume Next
                MkDir (Mid(strFolder, 2, Len(strFolder) - 1))
                On Error GoTo 0
            End If
        Next x
    Next i
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,537
Messages
6,114,216
Members
448,554
Latest member
Gleisner2

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