Hi Mynda,
Hope all well. Please could you assist and have a look at the VBA.
I routinely create an established range of Folders to accept Worksheet Reports and Charts printed by Macro as PDF's to the Subdirectory Structure.
As the location of the main worksheet changes, I create the lead Directory ("Report") relative to the location of the Worksheet. The Macros that print the reports work from the relative positon of the Worksheet.
To further assist, and given that it is an established range of subdirectories, I created a Macro to establish these subdirectories attached to a Button, which has been done for all the PDF Reports.
This Macro creates the lead Directory ("Reports") which is working.
For each of the main 15 subdirectory structures, I have used an Array that holds the names of those separate subdirectories under the main "Report" subdirectory. So there are multiple Arrays catering for each in sequence within the Macro.
However, these are not working.
I would be grateful for your assistance to understand why not / what I have done incorrectly.
The exported "bas" file text is pasted below.
Kind regards
Gavin Wehlburg
Sub CreateMacroPrintSubDirectoryStructure()
Dim currentDir As String
Dim requiredSubdirName As String
Dim parentFolder As String
Dim subFolders As Variant
Dim i As Integer
' Define the parent folder path and name and then Make the Directory
which will reside under this File's location
currentDir = ActiveWorkbook.Path
requiredSubdirName = "\Reports"
parentFolder = currentDir & requiredSubdirName
MkDir parentFolder
' Check if the parent folder exists, if not, create it
If Dir(parentFolder, vbDirectory) = "" Then
MkDir parentFolder
End If
' Define the subfolders to create = Independence = Bronze and Directors
1 to 15
subFolders = Array("Ind\Bronze\Board", "Ind\Bronze\D1", "Ind\Bronze\D2",
"Ind\Bronze\D3", "Ind\Bronze\D4", "Ind\Bronze\D5", "Ind\Bronze\D6",
"Ind\Bronze\D7", "Ind\Bronze\D8", "Ind\Bronze\D9", "Ind\Bronze\D10",
"Ind\Bronze\D11", "Ind\Bronze\D12", "Ind\Bronze\D13", "Ind\Bronze\D14",
"Ind\Bronze\D15")
' Loop through the subfolders array and create each subfolder
For i = LBound(subFolders) To UBound(subFolders)
' Prevent errors if folder already exists
On Error Resume Next
MkDir parentFolder & "\" & subFolders(i)
' Reset error handling
On Error GoTo 0
Next i
' Define the subfolders to create = Independence = Silver and Directors
1 to 15
subFolders = Array("Ind\Silver\Board", "Ind\Silver\D1", "Ind\Silver\D2",
"Ind\Silver\D3", "Ind\Silver\D4", "Ind\Silver\D5", "Ind\Silver\D6",
"Ind\Silver\D7", "Ind\Silver\D8", "Ind\Silver\D9", "Ind\Silver\D10",
"Ind\Silver\D11", "Ind\Silver\D12", "Ind\Silver\D13", "Ind\Silver\D14",
"Ind\Silver\D15")
' Loop through the subfolders array and create each subfolder
For i = LBound(subFolders) To UBound(subFolders)
' Prevent errors if folder already exists
On Error Resume Next
MkDir parentFolder & "\" & subFolders(i)
' Reset error handling
On Error GoTo 0
Next i
' Define the subfolders to create = Independence = Gold and Directors 1
to 15
subFolders = Array("Ind\Gold\Board", "Ind\Gold\D1", "Ind\Gold\D2",
"Ind\Gold\D3", "Ind\Gold\D4", "Ind\Gold\D5", "Ind\Gold\D6", "Ind\Gold\D7",
"Ind\Gold\D8", "Ind\Gold\D9", "Ind\Gold\D10", "Ind\Gold\D11",
"Ind\Gold\D12", "Ind\Gold\D13", "Ind\Gold\D14", "Ind\Gold\D15")
' Loop through the subfolders array and create each subfolder
For i = LBound(subFolders) To UBound(subFolders)
' Prevent errors if folder already exists
On Error Resume Next
MkDir parentFolder & "\" & subFolders(i)
' Reset error handling
On Error GoTo 0
Next i
' Define the subfolders to create = Liability = Bronze and Directors 1
to 15
subFolders = Array("Lia\Bronze\Board", "Lia\Bronze\D1", "Lia\Bronze\D2",
"Lia\Bronze\D3", "Lia\Bronze\D4", "Lia\Bronze\D5", "Lia\Bronze\D6",
"Lia\Bronze\D7", "Lia\Bronze\D8", "Lia\Bronze\D9", "Lia\Bronze\D10",
"Lia\Bronze\D11", "Lia\Bronze\D12", "Lia\Bronze\D13", "Lia\Bronze\D14",
"Lia\Bronze\D15")
' Loop through the subfolders array and create each subfolder
For i = LBound(subFolders) To UBound(subFolders)
' Prevent errors if folder already exists
On Error Resume Next
MkDir parentFolder & "\" & subFolders(i)
' Reset error handling
On Error GoTo 0
Next i
' Define the subfolders to create = Liability = Silver and Directors 1
to 15
subFolders = Array("Lia\Silver\Board", "Lia\Silver\D1", "Lia\Silver\D2",
"Lia\Silver\D3", "Lia\Silver\D4", "Lia\Silver\D5", "Lia\Silver\D6",
"Lia\Silver\D7", "Lia\Silver\D8", "Lia\Silver\D9", "Lia\Silver\D10",
"Lia\Silver\D11", "Lia\Silver\D12", "Lia\Silver\D13", "Lia\Silver\D14",
"Lia\Silver\D15")
' Loop through the subfolders array and create each subfolder
For i = LBound(subFolders) To UBound(subFolders)
' Prevent errors if folder already exists
On Error Resume Next
MkDir parentFolder & "\" & subFolders(i)
' Reset error handling
On Error GoTo 0
Next i
' Define the subfolders to create = Liability = Gold and Directors 1 to
15
subFolders = Array("Lia\Gold\Board", "Lia\Gold\D1", "Lia\Gold\D2",
"Lia\Gold\D3", "Lia\Gold\D4", "Lia\Gold\D5", "Lia\Gold\D6", "Lia\Gold\D7",
"Lia\Gold\D8", "Lia\Gold\D9", "Lia\Gold\D10", "Lia\Gold\D11",
"Lia\Gold\D12", "Lia\Gold\D13", "Lia\Gold\D14", "Lia\Gold\D15")
' Loop through the subfolders array and create each subfolder
For i = LBound(subFolders) To UBound(subFolders)
' Prevent errors if folder already exists
On Error Resume Next
MkDir parentFolder & "\" & subFolders(i)
' Reset error handling
On Error GoTo 0
Next i
' Define the subfolders to create = Governance = Bronze and Directors 1
to 15
subFolders = Array("Gov\Bronze\Board", "Gov\Bronze\D1", "Gov\Bronze\D2",
"Gov\Bronze\D3", "Gov\Bronze\D4", "Gov\Bronze\D5", "Gov\Bronze\D6",
"Gov\Bronze\D7", "Gov\Bronze\D8", "Gov\Bronze\D9", "Gov\Bronze\D10",
"Gov\Bronze\D11", "Gov\Bronze\D12", "Gov\Bronze\D13", "Gov\Bronze\D14",
"Gov\Bronze\D15")
' Loop through the subfolders array and create each subfolder
For i = LBound(subFolders) To UBound(subFolders)
' Prevent errors if folder already exists
On Error Resume Next
MkDir parentFolder & "\" & subFolders(i)
' Reset error handling
On Error GoTo 0
Next i
' Define the subfolders to create = Governance = Silver and Directors 1
to 15
subFolders = Array("Gov\Silver\Board", "Gov\Silver\D1", "Gov\Silver\D2",
"Gov\Silver\D3", "Gov\Silver\D4", "Gov\Silver\D5", "Gov\Silver\D6",
"Gov\Silver\D7", "Gov\Silver\D8", "Gov\Silver\D9", "Gov\Silver\D10",
"Gov\Silver\D11", "Gov\Silver\D12", "Gov\Silver\D13", "Gov\Silver\D14",
"Gov\Silver\D15")
' Loop through the subfolders array and create each subfolder
For i = LBound(subFolders) To UBound(subFolders)
' Prevent errors if folder already exists
On Error Resume Next
MkDir parentFolder & "\" & subFolders(i)
' Reset error handling
On Error GoTo 0
Next i
' Define the subfolders to create = Liability = Gold and Directors 1 to
15
subFolders = Array("Gov\Gold\Board", "Gov\Gold\D1", "Gov\Gold\D2",
"Gov\Gold\D3", "Gov\Gold\D4", "Gov\Gold\D5", "Gov\Gold\D6", "Gov\Gold\D7",
"Gov\Gold\D8", "Gov\Gold\D9", "Gov\Gold\D10", "Gov\Gold\D11",
"Gov\Gold\D12", "Gov\Gold\D13", "Gov\Gold\D14", "Gov\Gold\D15")
' Loop through the subfolders array and create each subfolder
For i = LBound(subFolders) To UBound(subFolders)
' Prevent errors if folder already exists
On Error Resume Next
MkDir parentFolder & "\" & subFolders(i)
' Reset error handling
On Error GoTo 0
Next i
' Define the subfolders to create = Internal Reporting for 6 Sections and
their 33 Subcategories
subFolders = Array("GRC\Summary", "GRC\IndDir", "GRC\TheBoard",
"GRC\Dynamics", "GRC\BoardCommittees", "GRC\Shareholders", "GRC\Disclosure")
' Loop through the subfolders array and create each subfolder
For i = LBound(subFolders) To UBound(subFolders)
' Prevent errors if folder already exists
On Error Resume Next
MkDir parentFolder & "\" & subFolders(i)
' Reset error handling
On Error GoTo 0
Next i
MsgBox "Subdirectory structure created successfully!", vbInformation
End Sub
Hi Mynda,
I have worked through and isolated the problem and revised a solution which I am pasting below for any other users that may have the same need and or problem.
The key problem, which was not documented in any Microsoft reading material (or other online posts that I trawled for 2 days!!) is that the MkDir command can only make a subdirectory to one level below. The Array Code above, when you step through and highlight each component of the Code, correctly accumulated the required subdirectory structure from the Array but failed on the MkDir command.
The revised solution requires a nested creation approach so that multi-level subdirectory structures, these are then built at a level at a time. This Nesting Approach is added as a sub to the main macro and called in the Array procedure.
This macro will now work to 1. Create a pre-named subdirectory underneath the location of the Worksheet, irrespective of its location, and 2. Create a subdirectory structure to any length, provided it is structured in the format indicated within the Macro.
Hope this helps and is adaptable to other Users' situations.
Kind regards
Gavin Wehlburg
Sub CreateMacroPrintSubDirectoryStructure()
Dim currentDir As String
Dim requiredSubdirName As String
Dim parentFolder As String
Dim subFolders As Variant
Dim i As Integer
' Get workbook location and define base folder
currentDir = ActiveWorkbook.Path
requiredSubdirName = "\Reports"
parentFolder = currentDir & requiredSubdirName
' Create the base Reports folder if it doesn't exist
If Dir(parentFolder, vbDirectory) = "" Then
MkDir parentFolder
End If
' All subfolder paths
subFolders = Array( _
"Ind\Bronze\Board", "Ind\Bronze\D1", "Ind\Bronze\D2", "Ind\Bronze\D3", "Ind\Bronze\D4", "Ind\Bronze\D5", "Ind\Bronze\D6", "Ind\Bronze\D7", "Ind\Bronze\D8", "Ind\Bronze\D9", "Ind\Bronze\D10", "Ind\Bronze\D11", "Ind\Bronze\D12", "Ind\Bronze\D13", "Ind\Bronze\D14", "Ind\Bronze\D15", _
"Ind\Silver\Board", "Ind\Silver\D1", "Ind\Silver\D2", "Ind\Silver\D3", "Ind\Silver\D4", "Ind\Silver\D5", "Ind\Silver\D6", "Ind\Silver\D7", "Ind\Silver\D8", "Ind\Silver\D9", "Ind\Silver\D10", "Ind\Silver\D11", "Ind\Silver\D12", "Ind\Silver\D13", "Ind\Silver\D14", "Ind\Silver\D15", _
"Ind\Gold\Board", "Ind\Gold\D1", "Ind\Gold\D2", "Ind\Gold\D3", "Ind\Gold\D4", "Ind\Gold\D5", "Ind\Gold\D6", "Ind\Gold\D7", "Ind\Gold\D8", "Ind\Gold\D9", "Ind\Gold\D10", "Ind\Gold\D11", "Ind\Gold\D12", "Ind\Gold\D13", "Ind\Gold\D14", "Ind\Gold\D15", _
"Lia\Bronze\Board", "Lia\Bronze\D1", "Lia\Bronze\D2", "Lia\Bronze\D3", "Lia\Bronze\D4", "Lia\Bronze\D5", "Lia\Bronze\D6", "Lia\Bronze\D7", "Lia\Bronze\D8", "Lia\Bronze\D9", "Lia\Bronze\D10", "Lia\Bronze\D11", "Lia\Bronze\D12", "Lia\Bronze\D13", "Lia\Bronze\D14", "Lia\Bronze\D15", _
"Lia\Silver\Board", "Lia\Silver\D1", "Lia\Silver\D2", "Lia\Silver\D3", "Lia\Silver\D4", "Lia\Silver\D5", "Lia\Silver\D6", "Lia\Silver\D7", "Lia\Silver\D8", "Lia\Silver\D9", "Lia\Silver\D10", "Lia\Silver\D11", "Lia\Silver\D12", "Lia\Silver\D13", "Lia\Silver\D14", "Lia\Silver\D15", _
"Lia\Gold\Board", "Lia\Gold\D1", "Lia\Gold\D2", "Lia\Gold\D3", "Lia\Gold\D4", "Lia\Gold\D5", "Lia\Gold\D6", "Lia\Gold\D7", "Lia\Gold\D8", "Lia\Gold\D9", "Lia\Gold\D10", "Lia\Gold\D11", "Lia\Gold\D12", "Lia\Gold\D13", "Lia\Gold\D14", "Lia\Gold\D15", _
"Gov\Bronze\Board", "Gov\Bronze\D1", "Gov\Bronze\D2", "Gov\Bronze\D3", "Gov\Bronze\D4", "Gov\Bronze\D5", "Gov\Bronze\D6", "Gov\Bronze\D7", "Gov\Bronze\D8", "Gov\Bronze\D9", "Gov\Bronze\D10", "Gov\Bronze\D11", "Gov\Bronze\D12", "Gov\Bronze\D13", "Gov\Bronze\D14", "Gov\Bronze\D15", _
"Gov\Silver\Board", "Gov\Silver\D1", "Gov\Silver\D2", "Gov\Silver\D3", "Gov\Silver\D4", "Gov\Silver\D5", "Gov\Silver\D6", "Gov\Silver\D7", "Gov\Silver\D8", "Gov\Silver\D9", "Gov\Silver\D10", "Gov\Silver\D11", "Gov\Silver\D12", "Gov\Silver\D13", "Gov\Silver\D14", "Gov\Silver\D15", _
"Gov\Gold\Board", "Gov\Gold\D1", "Gov\Gold\D2", "Gov\Gold\D3", "Gov\Gold\D4", "Gov\Gold\D5", "Gov\Gold\D6", "Gov\Gold\D7", "Gov\Gold\D8", "Gov\Gold\D9", "Gov\Gold\D10", "Gov\Gold\D11", "Gov\Gold\D12", "Gov\Gold\D13", "Gov\Gold\D14", "Gov\Gold\D15", _
"GRC\Summary", "GRC\IndDir", "GRC\TheBoard", "GRC\Dynamics", "GRC\BoardCommittees", "GRC\Shareholders", "GRC\Disclosure")
' Loop through subfolders and create them
For i = LBound(subFolders) To UBound(subFolders)
CreateNestedFolders parentFolder & "\" & subFolders(i)
Next i
MsgBox "Subdirectory structure created successfully!", vbInformation
End Sub
' Helper: Create nested folders one level at a time
Sub CreateNestedFolders(fullPath As String)
Dim parts() As String
Dim pathBuild As String
Dim j As Integer
parts = Split(fullPath, "\")
pathBuild = parts(0)
On Error Resume Next
For j = 1 To UBound(parts)
pathBuild = pathBuild & "\" & parts(j)
If Dir(pathBuild, vbDirectory) = "" Then
MkDir pathBuild
End If
Next j
On Error GoTo 0
End Sub