Dynamische Range

[Ocirne]

Hallo,

Ik werk vanuit een bestand waarin cliëntgegevens zijn opgenomen. Zodra een nieuwe cliënt wordt aangemaakt, kan middels een macro een directory met de naam van de cliënt worden aangemaakt met een aantal voorgeschreven subdirectory's.

De code hiervoor is:

Sub MakeSelectionDir()

sPad1 = Cells(Selection.Row, 65) & "\Aantekeningen"
sPad2 = Cells(Selection.Row, 65) & "\Overeenkomsten"
sPad3 = Cells(Selection.Row, 65) & "\Rapportages"

If Dir(sPad1, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & sPad1 & """")
End If

If Dir(sPad2, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & sPad2 & """")
End If

If Dir(sPad3, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & sPad3 & """")
End If
    

End Sub

Dit werkt op zich prima. Nu loop ik tegen het probleem aan dat de kolom (i.c. kolom 65) in het bestand nog wel eens wil wisselen. Dat betekent dat ik handmatig bovenstaande code moet aanpassen voor juiste verwijzing naar de kolomindex. Ik heb geprobeerd dat dynamisch door de kolom een veldnaam te geven (i.c. ClientDir). Als ik de code voor de voorgedefinieerde paden aanpas in bijv. sPad1 = Cells(Selection.Row, [ClientDir]) & "\Aantekeningen" krijg ik op die regels een foutmelding. Hoe krijg ik toch een dynamisch kolommenbereik?

Alvast dank voor jullie hulp!

Mvg,

Ocirne

 

[edmoor]

Hiervoor kan je beter even een voorbeeldocumentje met de verschillende situaties plaatsen.
Daarnaast, waarom gebruik je niet gewoon Mkdir van VBA zelf? Dan heb je die Shell opdrachten helemaal niet nodig.

 

[VenA]

Om het kolomnummer op te halen als ClientDir is de eerste rij staat:

MsgBox Application.Match("ClientDir", Rows(1), 0)

 

[Ocirne]

Ik heb een voorbeeldje bijgevoegd. Hierbij is de verwijzing voor de cliëntenmap in kolom 3. Als ik een kolom tussenvoeg (zodat de cliëntenmap dan kolom 4 wordt), moet ik dus de code aanpassen. Ik zou dat graag automatisch mee willen laten verschuiven.

Met die Shell-opdrachten weet ik zeker dat een subdirectory wordt aangemaakt, ongeacht of de bovenliggende map al wel of niet bestaat. Heb jij een vergelijkbare, efficiënte manier?

 

[VenA]

Blijkbaar #3 gemist? De kolomkop in jouw bestand is ook geen ClientDir maar Map.

Sub MakeSelectionDir()
j = Application.Match("Map", Rows(1), 0)

sPad1 = Cells(Selection.Row, j) & "\Aantekeningen"
sPad2 = Cells(Selection.Row, j) & "\Overeenkomsten"
sPad3 = Cells(Selection.Row, j) & "\Rapportages"

If Dir(sPad1, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & sPad1 & """")
End If

If Dir(sPad2, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & sPad2 & """")
End If

If Dir(sPad3, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & sPad3 & """")
End If
End Sub

 

[Ocirne]

Hi VenA,

Yep. Ik reageerde vanuit mail die ik kreeg op #2.

Fijn dat je reageert, want jouw oplossing werkt top!

In mijn voorbeeldbestand heb ik kolom C 'ClientDir' genoemd, te bereiken via ctrl-f3. Afijn, dat laatste weet je ongetwijfeld ook al wel

In ieder geval bedankt!

Mvg,

Ocirne

 

[VenA]

Dat je aan de betreffende kolom een naam hebt toegekend staat volgens mij nergens behalve in jouw laatste reactie.

Als je perse aan Shell wilt vasthouden kan je het nog wel een beetje inkorten:

Sub VenA()
j = Application.Match("Map", Rows(1), 0)
For Each it In Array("Aantekeningen", "Overeenkomsten", "Rapportages")
    If Dir(Cells(Selection.Row, j) & "\" & it, vbDirectory) = "" Then Shell ("cmd /c mkdir """ & Cells(Selection.Row, j) & "\" & it & """")
Next it
End Sub

 

[Ocirne]

Top VenA!

Nee, ik hoef per se niet aan de Shell vast te houden. Ik ken alleen geen andere manier om ervoor te zorgen dat subdirectory's ook worden aangemaakt, als de bovenliggende map (of mappen) nog niet bestaat.

 

[HSV]

Zonder lusje als je de formule in kolom C veranderd in:

=ALS(B2="";"";B2&", "&A2)

Sub hsv()
j = Application.Match("Map", Rows(1), 0)
With CreateObject("shell.application").Namespace("D:")
     .newfolder Cells(Selection.Row, j) & "\Aantekeningen"
     .newfolder Cells(Selection.Row, j) & "\Overeenkomsten\"
     .newfolder Cells(Selection.Row, j) & "\Rapportages\"
   End With
End Sub