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\
in t
Thank you,
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,