macro/vba om automatisch mappen aan te maken

[Senso]

Is er een code/macro om automatisch mappen aan te maken.

Bekijk bijlage senso2.xlsx

Voorbeeld eindresultaat:

 

[VenA]

Nee. En zeker niet met de zeer, wederom, beperkte omschreven vraag en voorbeeld.

Een map moet ergens beginnen waar? C:\?
mapnamen moeten aan bepaalde voorwaarden voldoen. Denk hierbij aan tekens die wel/niet mogen maximale lengte etc.

Probeer deze maar handmatig aan te maken 'Badische Anilin- & Soda-Fabrik / Badense Aniline- & Soda-Fabriek '

 

[Senso]

Volgens mij heb ik het wel goed omschreven en toegelicht met bestanden/voorbeelden.

De mappen maak ik altijd aan in E:\test\

Je bent afhankelijk van de bestandsnaam. De mapnaam wordt dan niet aangemaakt als tekens niet in de bestandsnaam mogen voorkomen. Dat is met de macro in Word ook het geval. Goed, dan worden er van de honderd, negentig niet aangemaakt. Dit nadeel weegt niet op tegen het voordeel van automatisch aanmaken van de overige negentig.

Ik kan ook snel even zoeken binnen Excel en bijvoorbeeld \/:*?"<>| vervangen. Maximale lengte Windows 7 255 tekens, dat is vrijwel altijd voldoende.

In mijn voorbeeldbestand senso2 vormen kolom B, C, D, en E de mapnaam.

dus dat wordt dan: afk ABZ (123, o) Algemeen Bestuurlijke Zaken

Ik kwam op Helpmij.nl een topic tegen al uit 2009 en daar stond ongeveer dezelfde vraag. Alleen ben even de link kwijt. Gevonden.

Sub MaakMappen()
    Dim q1 As Variant, i As Integer
    On Error Resume Next
    q1 = Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    For i = LBound(q1) To UBound(q1)
        If Dir("D:\" & q1(i, 1)) = "" Then MkDir "D:\" & q1(i, 1)
        MkDir "D:\" & q1(i, 1) & "\" & q1(i, 2)
    Next i
End Sub

Ik kan niet beoordelen wat de uitwerking hiervan is.
Zoiets?

Sub MaakMappen()
    Dim q1 As Variant, i As Integer
    On Error Resume Next
    q1 = Range("B1:E" & Cells(Rows.Count, 1).End(xlUp).Row)
    For i = LBound(q1) To UBound(q1)
        If Dir("D:\" & q1(i, 1)) = "" Then MkDir "E:\test\" & q1(i, 1)
        MkDir "D:\" & q1(i, 1) & "\" & q1(i, 2)
    Next i
End Sub

 

[edmoor]

Als bij een fout een map niet gemaakt hoeft te worden is het simpelweg dit:

Sub MaakMappen()
    On Error Resume Next
    For Each cl In Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        MkDir "E:\Test\" & Join(Application.Transpose(Application.Transpose(Range("B" & cl.Row).Resize(, 4).Value)), " ")
    Next cl
End Sub

 

[Senso]

Bedankt, ga ik proberen. Waar zit dan die "Range" in de code van kolom B C D en E?

 

[edmoor]

Hier:

Range("B" & cl.Row).Resize(, 4).Value)

 

[Senso]

Begrijp ik het goed, dat "B" in dit geval de beginkolom is en willekeurig aangepast kan worden en 4 staat voor de eindkolom E dus als G de eindkolom is, maak je van de 4 een zes?

Ik heb de macro getest en werkt prima, is een groot succes. Bedankt voor de hulp.

 

[edmoor]

Dat heb je goed begrepen.

 

[Senso]

Mooi. Ga later verder. De eerste volledige test gedaan en dat werkt honderd maal sneller. Vrijwel alle regels worden omgezet in mappen. Beetje corrigeren hier en daar en klaar. Geweldig dat je me toch nog geholpen hebt Edmoor. Dacht dat je een beetje boos was. Anderen ook bedankt voor de hulp.

 

[edmoor]

Boos?
Nee hoor, geen enkele reden voor