Forum

Creating an Establi...
 
Notifications
Clear all

Creating an Established range of Folders to Accept Reports using as Array

2 Posts
1 Users
0 Reactions
197 Views
(@gavin-wehlburgwehlburg-com)
Posts: 4
Active Member
Topic starter
 

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

 
Posted : 20/05/2025 1:36 am
(@gavin-wehlburgwehlburg-com)
Posts: 4
Active Member
Topic starter
 

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

 
Posted : 21/05/2025 4:27 pm
Share: