Vba code voor maken van een map in verkenner

Status
Niet open voor verdere reacties.
H

hein68

Gebruiker
Lid geworden
18 mrt 2016
Berichten
48
Hallo,

Ik ben op dit forum op zoek gegaan om met Vba een map aan te maken met VBA. Ik heb twee posts van @warme bakkertje gevonden dus dat krijg ik voor elkaar. Echter zoek ik nog wat meer.

Ik heb een xls werkmap met in kolom A een nummer in B een datum en in C een status. Zodra ik de status aanpas (er zijn er 6) druk ik op opslaan. Nu wil ik dat als de status “klaar” in vak C staat, er een map aangemaakt wordt met naam van kolom A op een specifieke locatie in de verkenner ( pad staat in cel G1)
met daarin twee submappen formulieren en bestanden.

Ik hoop dat jullie mij kunnen helpen.
Map aanmaken en ook submap heb ik reeds gevonden en lukt. Het lukt mij niet de of then na opslaan te maken omdat ik te weinig kennis heb

Hein
 
Hoi,

Post even een bestandje met de code die je nu hebt, dat maakt het wat makkelijker.
 
Laatst bewerkt:
Het zal iets zijn in deze trend:

Code: 
Dim var as Variant

var = Range("A1").Value

If ("Klaar" = var) then
  ActiveWorkbook.SaveAs "new"
Enf if
 
Hoi maarten, dank voor jou reactie.

Warme bakkertje heeft in topic Vba code voor map aanmaken gepost en ook voor submap. Dat was voor mij navolgbaar maar heb dus nog geen code met if then. Heb door fouten de bestanden net gewist waardoor ik dat wat ik had niet kan uploaden. Probeer weer opnieuw te doen.
 
dit is de code om dmv doubleclick een map te maken in de directory

Code: 
 Private Sub Worksheet_beforeDoubleClick(ByVal Targwet As Range, Cancel As Boolean)
MkDir "R:\vbadossiers" & [A3].Value
End Sub
 
Laatst bewerkt:
voorbeeld xls

Bijgaand het xlsm bestandje met de double clivk macro van Rudi
 

Bijlagen

Geen idee wat of welke submappen er moeten worden aangemaakt.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(3)) Is Nothing Then
 If LCase(Target.Value) = "voltooid" And Application.CountA(Target.Offset(, -2).Resize(, 2)) = 2 Then
  ThisWorkbook.SaveAs Range("g1") & "\" & Target.Offset(, -2) & "_" & Target.Offset(, -1), 52
 End If
End If
End Sub
 
Thx Harry

Ik heb een xls werkmap met in kolom A een nummer in B een datum en in C een status. Zodra ik de status aanpas (er zijn er 6) druk ik op opslaan. Nu wil ik dat als de status “klaar” in vak C staat, er een map aangemaakt wordt met naam van kolom A op een specifieke locatie in de verkenner ( pad staat in cel G1)
met daarin twee submappen formulieren en bestanden.

Alvast bedankt voor aanvulling
 
Die twee submappen kun je aanmaken met:
Code: 
CreateObject("shell.application").Namespace(Range("g1") & "\").newfolder "formulieren\bestanden"

In zijn geheel wordt het dan.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(3)) Is Nothing Then
 If LCase(Target.Value) = "voltooid" And Application.CountA(Target.Offset(, -2).Resize(, 2)) = 2 Then
   CreateObject("shell.application").Namespace(Range("g1") & "\").newfolder "formulieren\bestanden"
  ThisWorkbook.SaveAs Range("g1") & "\" & "formulieren\bestanden\" & Target.Offset(, -2) & "_" & Target.Offset(, -1), 52
 End If
End If
End Sub

Let op: Ik zie nergens 'Klaar' staan, maar wel 'voltooid'.
 
Hoi harry,

dat hest goud doan :-) ik ben je zeer erkentelijk daarvoor. alleen is het nog niet exact wat ik moet hebben.Knipsel tbv vba.PNG

in het knipsel zie je hetgeen ik bedoel.
de waarde in A kolom van voltooid (ipv klaar, mijn excuses) is de naam van de map in de directory G1 met twee submappen formulieren en bestanden.

ik probeer dit zelf adhv jouw code maar mijn kennis reikt niet zover. ik begrijp de code niet helemaal.

gr Hein
 
ik heb zitten stoeien met de code maar kom er nog niet uit. de hoofdmap in de directory G1 moet de naam hebben van cel A van de rij waar c voltooid is en in die map met die naam de twee supmappen formulieren en bestanden.
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(3)) Is Nothing Then
 If LCase(Target.Value) = "voltooid" And Application.CountA(Target.Offset(, -2).Resize(, 2)) = 2 Then
   CreateObject("shell.application").Namespace(Range("g1" \ "cell(,-2") & "\").newfolder "formulieren" & "\").newfolder "bestanden"
  ThisWorkbook.SaveAs Range("g1" \ "cell(,-2") & "\" & "formulieren" & Target.Offset(, -1) & "\" & "bestanden" & Target.Offset(, -1), 52
 End If
End If
End Sub

dit is een resultaat van mijn stoeiwerk wat dus niet werkt. ik heb echt jullie hulp hierbij nodig.
dank alvast voor het meedenken.
 
Hahaha, goed gronings.
Dan wordt het zoiets met als bestandsnaam de datum van die cel ernaast.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(3)) Is Nothing Then
   If LCase(Target.Value) = "voltooid" And Application.CountA(Target.Offset(, -2).Resize(, 2)) = 2 Then
     If Dir(Range("g1") & "\" & Target.Offset(, -2), 16) = "" Then MkDir Range("g1") & "\" & Target.Offset(, -2)
     ThisWorkbook.SaveAs Range("g1") & "\" & Target.Offset(, -2) & "\" & Target.Offset(, -1), 52
   End If
End If
End Sub
of:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(3)) Is Nothing Then
   If LCase(Target.Value) = "voltooid" And Application.CountA(Target.Offset(, -2).Resize(, 2)) = 2 Then
     CreateObject("shell.application").Namespace(Range("g1") & "\").newfolder Target.Offset(, -2)
     ThisWorkbook.SaveAs Range("g1") & "\" & Target.Offset(, -2) & "\" & Target.Offset(, -1), 52
   End If
End If
End Sub
 
De naam van de map is waarde a cel van de rij
 
Laatst bewerkt:
Zo staat het ook in de gegeven code geschreven.
 
sorry ben in hongarije en was net met mijn kinderen uit eten :-)

zal het nu testen
 
Ok harry, de mapnaam is de juiste nu maar ik mis de submappen en de xls hoeft niet in deze mappen worden opgeslagen.Dus mapnaam met waarde A en twee lege submappen met de namen formulieren en bestanden

gr Hans
 
Is dit wat je voor ogen hebt?.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(3)) Is Nothing Then
   If LCase(Target.Value) = "voltooid" And Application.CountA(Target.Offset(, -2).Resize(, 2)) = 2 Then
     With CreateObject("shell.application").Namespace(Range("g1") & "\")
       .newfolder Target.Offset(, -2) & "\Formulieren"
       .newfolder Target.Offset(, -2) & "\Bestanden"
    End With
   End If
End If
End Sub
 
Kijk nu harry.

heb de code getest en dit is idd wat ik bedoelde. al goud.

ik ben blij dat je dit voor elkaar hebt gekregen waarvoor dank. ikzelf moet ontbeer nog de kennis waar ik aan zal moeten werken. Thx

creerde je met deze regel nu de map met naam cel A incl de submap?
 
Laatst bewerkt:
Hoi Harry,

ik heb nu twee kolommen ingevoegd voor een overzichtilijker beeld waardoor de voltooid nu in kolom e plaatsvind.

ik heb de column van 3 naar 5 aangepast en de offset van -2 naar -4 maar hij geeft een fout bij de submappen. kun je mij daar nog mee helpen.

voor de zuiverheid heb ik dit topic op opgelost gezet en voor deze vraag een nieuw topic gestart

Mod edit: Bericht aangepast
 
Laatst bewerkt door een moderator:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan