Met VBA 2 nieuwe mappen aanmaken

[pvag]

Beste experts,

Op het forum heb ik met hulp van de experts een code mogen ontvangen die goed werkt.
De code maakt een map aan die als String elders uit de sheet gehaald wordt.
Nu is mijn vraag of met onderstaande code tegelijk meerdere mappen kunnen worden aangemaakt, en zo ja, hoe?
Ik ben al een hele tijd aan het stoeien geweest maar kom er niet uit.
Wie kan mij verder helpen?
Alvast bedankt.
Gr, Ton

Dim sPath As String
 Dim sPad As String
 Dim Pad() As String
 Dim i As Integer
 Dim sYear As String
 sYear = CStr(Year(Date))
    
   sPad = Sheets("Param").Range("D5").Value & "\"            ' Is E:\Werkmap\TDEP_new\Administratie\Kasboeken
   ' Dit is de 2e map die moet worden aangemaakt   = Sheets("Param").Range("D6").Value & "\"  ' Is E:\Werkmap\TDEP_new\Administratie\Sjabloon kasboek
        
    Pad = Split(sPad, "\")
    sPad = Pad(0)
    For i = 1 To UBound(Pad)
        sPad = sPad & "\" & Pad(i)
        If Dir(sPad, vbDirectory) = "" Then
        MkDir sPad
        End If
    Next i

 

[OctaFish]

Het makkelijkst is natuurlijk om de lus 2 keer uit te voeren:

   sPad = Sheets("Param").Range("D5").Value & "\"
    Pad = Split(sPad, "\")
    sPad = Pad(0)
    For i = 1 To UBound(Pad)
        sPad = sPad & "\" & Pad(i)
        If Dir(sPad, vbDirectory) = "" Then
        MkDir sPad
        End If
    Next i
   
   sPad = Sheets("Param").Range("D6").Value & "\"
    Pad = Split(sPad, "\")
    sPad = Pad(0)
    For i = 1 To UBound(Pad)
        sPad = sPad & "\" & Pad(i)
        If Dir(sPad, vbDirectory) = "" Then
        MkDir sPad
        End If
    Next i

 

[edmoor]

Of een aparte Sub voor het maken van een folder:

In je originele Sub

   Call MaakFolder(Sheets("Param").Range("D5").Value & "\")
   Call MaakFolder(Sheets("Param").Range("D6").Value & "\")

En deze nieuwe Sub:

Sub MaakFolder(Naam As String)
    Pad = Split(Naam, "\")
    Naam = Pad(0)
    For i = 1 To UBound(Pad)
        Naam = Naam & "\" & Pad(i)
        If Dir(Naam, vbDirectory) = "" Then
            MkDir Naam
        End If
    Next i
End Sub

 

[pvag]

Best OctaFish en edmoor,

Wat zijn jullie keien!!
Dat spelen met VBA doen jullie als iets langer dan 'maand. Ik druk dat uit als spelen, maar ik heb het idee dat het voor jullie spelen is. Hahaha. De adviezen die jullie me gaven zijn werkelijk perfect. Zonder de hulp van alle experts binnen het forum, zou ik weken moeten zoeken, proberen en testen, omdat ik maar een oude leek van bijna 67 jaar. Ik ben wel heel leergierig en geef nooit op. Ik snap zelfs van bepaalde dingen uit het forum niet. Ik zou jullie een pluimpje willen geven maar weet niet hoe, maar ook dat ga ik uitzoeken.
Heel hartelijk dank voor jullie hulp.
Groetjes, Ton

 

[OctaFish]

Soms is het niet veel meer dan even iets verder kijken... Als je een handeling 2 keer uit wilt voeren, dan is er weinig op tegen om een stukje code te kopiëren en plakken. Zelf kies ik dan (in dit geval) voor de simpelste oplossing; er een aparte functie van maken had ik uiteraard ook wel bedacht, maar als het eenmalig is, waarom zou je dat dan doen? Aparte functies hebben pas nut als je ze vaker nodig hebt. Dan moet je ze natuurlijk ook niet in de werkmap zelf zetten, maar in je Personal.xlsb, want anders heb je er nog steeds niks aan in de toekomst.