Create Sub-folder in Each of the Folders in a Browsed Directory

damaniam1604

New Member
Joined
Sep 12, 2018
Messages
20
Essentially, I want to be able to highlight a list in a column and run the macro. The end result would be that the macro would allow me to browse for the desired folder and within each sub-folder of the desired folder, a file for each name on the list will be created.

For example, I want to create 12 month named folders in each company's file. There are 17 company files in the desired directory.

Any help would be greatly appreciated. Thanks in advance.
 

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.
Hello damaniam1604,

This macro will let you select the folder and then add new folders using the range selected on the worksheet.

Code:
Sub AddSubFolders()


    Dim Cell        As Range
    Dim Folder      As Variant
    Dim SubFolders  As Object
    Dim Rng         As Range
    
        If TypeName(Selection) <> "Range" Then Exit Sub
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show Then Folder = .SelectedItems(1) Else Exit Sub
        End With
        
        With CreateObject("Shell.Application")
            Set SubFolders = .Namespace(Folder).Items
                SubFolders.Filter 32, "*"
            If SubFolders.Count = 0 Then
                MsgBox "There are No Subfolders in this Directory.", vbExclamation
                Exit Sub
            End If
        End With
        
        For Each Folder In SubFolders
            If Not (Folder.Type Like "Compressed*") Then
                For Each Cell In Rng.Cells
                    On Error Resume Next
                        MkDir Folder.Path & "\" & Cell.Text
                    On Error GoTo 0
                Next Cell
            End If
        Next Folder
        
End Sub
 
Upvote 0
Thank you for your response. I can't get the code to run without error. It returns a run-time error '91': Object variable or With block variable not set. It points to the link "For Each Cell In Rng.Cells" as the error in debug mode.
 
Upvote 0
Hello damaniam1604,

Sorry, I forgot to change the code after troubleshooting it. Try this...

Code:
[/COLOR]Sub AddSubFolders()


    Dim Cell        As Range
    Dim Folder      As Variant
    Dim SubFolders  As Object
    Dim Rng         As Range
    
        If TypeName(Selection) <> "Range" Then Exit Sub Else Set Rng = Selection
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show Then Folder = .SelectedItems(1) Else Exit Sub
        End With
        
        With CreateObject("Shell.Application")
            Set SubFolders = .Namespace(Folder).Items
                SubFolders.Filter 32, "*"
            If SubFolders.Count = 0 Then
                MsgBox "There are No Subfolders in this Directory.", vbExclamation
                Exit Sub
            End If
        End With
        
        For Each Folder In SubFolders
            If Not (Folder.Type Like "Compressed*") Then
                For Each Cell In Rng.Cells
                    On Error Resume Next
                        If Cell <> "" Then MkDir Folder.Path & "\" & Cell.Text
                    On Error GoTo 0
                Next Cell
            End If
        Next Folder
        
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

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