Creating Sub folders

josros60

Well-known Member
Joined
Jun 27, 2010
Messages
790
Office Version
  1. 365
Hi,

I have the code below how can it be modify to create sub folders in already year folders created with another macro,

I would like to create the following sub folders in a already created month end folder like:
C:\user\MonthEnd\2025\06 Jun 2025\

Accruals andAP
AR and Revenue
Bank
FA
Inventory
Prepaid_Deposits_Other

in t


VBA Code:
Sub CreateFolders()

    Dim aCustomers
    Dim aArticles
    Dim i
    Dim j
    Dim sPath
    Dim Msg As String




    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Folder"
        .AllowMultiSelect = False
        .InitialFileName = "\\mtlnas01\Share\Accountant Files\Month-EndClosing2025"
        If .Show Then
            sPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    With ThisWorkbook.Sheets(1)
    aCustomers = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1).Value
    'aCustomers = .Range(.Range("A1"), .Range("A1").End(xlDown)).Value
        
        aArticles = .Range("B1:B7").Value
    End With
       
       For i = LBound(aCustomers, 1) To UBound(aCustomers, 1) - 1
    'For i = LBound(aCustomers, 1) To UBound(aCustomers, 1)
        For j = LBound(aArticles, 1) To UBound(aArticles, 1)
            SmartCreateFolder sPath & "\" & aCustomers(i, 1) & "\" & aArticles(j, 1)
        Next
    Next

MsgBox "Operation Complete.Employee BMO mastercard subfolders have been created in BMO MASTERCARD CORP. FOLDER." & Msg

  
End Sub

Sub SmartCreateFolder(sFolder)

    Static oFSO As Object

    If oFSO Is Nothing Then Set oFSO = CreateObject("Scripting.FileSystemObject")
    With oFSO
        If Not .FolderExists(sFolder) Then
            SmartCreateFolder .GetParentFolderName(sFolder)
            .CreateFolder sFolder
        End If
    End With

End Sub

Thank you,
 

Attachments

  • SUB FOLDERS.png
    SUB FOLDERS.png
    4.7 KB · Views: 3

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