Macro: variabele map maken en opslaan als

[krampit]

Beste mede VBA-ers,

Ik ben op zoek naar een combinatie van onderstaande 2 macro's.
Het is de bedoeling dat een dossier van een werknemer in zijn/haar persoonlijke map wordt opgeslagen. Wanneer een map nog niet bestaat, bijvoorbeeld bij een nieuwe werknemer, dan moet er eerst een map gemaakt worden waarna het bestand in deze map wordt opgeslagen. Indien de map al bestaat dan voldoet het opslaan van het bestand in de, al bestaande, map.

Zoals in de onderstaande macro is te zien lukt het wel om een juiste bestandsnaam te creëren, met als variabele cel Z1 van het tabblad "Gegevens werknemer".

Sub OpslaanAls()
'
' OpslaanAls Macro
'

'   MkDir "C:\Users\mark-\Documents\P&O\" & Sheets("gegevens werknemer").Range("Z1").Value
    ActiveWorkbook.SaveAs Filename:="C:\Users\mark-\Documents\P&O\" & Sheets("gegevens werknemer").Range("Z1").Value & ".xlsm"
    MsgBox "Dossier succesvol opgeslagen."
End Sub

Net zo goed dat het ook wel lukt om een nieuwe map te maken.

Sub mapmaken()

'
' Mapmaken macro
'

'
    MkDir "C:\Users\mark-\Documents\P&O\" & Sheets("gegevens werknemer").Range("Z1").Value
End Sub

De kunst wordt nu, hoe krijg ik die twee gecombineerd. Dus als ik de eerste macro "OpslaanAls" uitvoer, dat er dan automatisch een map gecreëerd wordt op de locatie C:\Users\mark-\Documents\P&O\ + "Sheets("gegevens werknemer").Range("Z1").Value". Indien de map al bestaat dan kan het bestand zich gewoon opslaan in de betreffende map.

De bestandsnaam is hetzelfde als de mapnaam (allebei cel Z1 van het tabblad "gegevens werknemer").

Ben ik zo duidelijk genoeg?

Ik hoop van harte dat iemand mij kan helpen, ben namelijk al een redelijke tijd aan het puzzelen.


Groet, krampit

 

[jkpieterse]

Je probleem is ook, dat een andere gebruiker een ander documenten pad heeft. Bovendien moet je het pad in onderdelen opbouwen:

Sub OpslaanAls()
    Dim sPad As String
    sPad = "C:\Users" & Environ("Username") & "\Documents\P&O"
    If Len(Dir(sPad, vbDirectory)) = 0 Then
        MkDir sPad
    End If
    sPad = sPad & "" & Sheets("gegevens werknemer").Range("Z1").Value
    If Len(Dir(sPad, vbDirectory)) = 0 Then
        MkDir sPad
    End If
    
    ActiveWorkbook.SaveAs Filename:=sPad & "" & Sheets("gegevens werknemer").Range("Z1").Value & ".xlsm"
    MsgBox "Dossier succesvol opgeslagen."
End Sub

 

[edmoor]

Ik zou deze gebruiken:
sPad = Environ("Userprofile") & "\Documents\P&O\"

 

[snb]

Of maak het je gemakkelijk met:

Sub M_snb()
  with Sheets("gegevens werknemer").Range("Z1")
    CreateObject("shell.application").Namespace(Environ("userprofile")).NewFolder "Documents\P&O_" & .Value
    ActiveWorkbook.SaveAs  Environ("userprofile") & "\Documents\P&O_" & .Value  &  .value & ".xlsm"
  end with
End Sub

 

[krampit]

Dank voor je reactie jkpieterse. Dit gaat echter de mist in bij "MkDir sPad". Hij geeft dan aan dat het pad niet gevonden kan worden.

Je probleem is ook, dat een andere gebruiker een ander documenten pad heeft. Bovendien moet je het pad in onderdelen opbouwen:

Sub OpslaanAls()
    Dim sPad As String
    sPad = "C:\Users" & Environ("Username") & "\Documents\P&O"
    If Len(Dir(sPad, vbDirectory)) = 0 Then
        MkDir sPad
    End If
    sPad = sPad & "" & Sheets("gegevens werknemer").Range("Z1").Value
    If Len(Dir(sPad, vbDirectory)) = 0 Then
        MkDir sPad
    End If
    
    ActiveWorkbook.SaveAs Filename:=sPad & "" & Sheets("gegevens werknemer").Range("Z1").Value & ".xlsm"
    MsgBox "Dossier succesvol opgeslagen."
End Sub

 

[krampit]

Dank voor je reactie Edmoor.
Het begint er op te lijken echter:
- De bestandsnaam wordt 2x hetzelfde. Dus bijvoorbeeld de waarde in cel Z1 = Krampit. Dan wordt de bestandsnaam krampit, krampit.
- Daarnaast wordt er wel een map "krampit" aangemaakt, echter staat het bestand hier nog niet in.
De map "krampit" en het bestand staan los in de map P&O, terwijl het bestand krampit ook in de map krampit moet zitten.

Is hier een mogelijkheid voor?

Ik zou deze gebruiken:
sPad = Environ("Userprofile") & "\Documents\P&O"

 

[krampit]

Bedankt voor je reactie SNB, dit is echter niet helemaal zoals ik het bedoel.
Er wordt met jou VBA een map aangemaakt P&O + bestandsnaam. Echter moet er een map, met als waarde cel Z1, aangemaakt worden IN de map P&O. Hier op aansluitend moet het bestand, wat ook de waarde van cel Z1 als bestandsnaam heeft, worden opgeslagen in de map, ook met waarde cel Z1, die reeds met de macro is gemaakt.

Kort gezegd:
Mapnaam en bestandsnaam zijn hetzelfde.
Indien mapnaam nog niet bestaat, dan map aanmaken en het bestand hier in zetten.
Indien mapnaam al wel bestaat, dan bestand hierin opslaan.

Of maak het je gemakkelijk met:

Sub M_snb()
  with Sheets("gegevens werknemer").Range("Z1")
    CreateObject("shell.application").Namespace(Environ("userprofile")).NewFolder "Documents\P&O_" & .Value
    ActiveWorkbook.SaveAs  Environ("userprofile") & "\Documents\P&O_" & .Value  &  .value & ".xlsm"
  end with
End Sub

 

[jkpieterse]

Bij de tweede MkDir waarschijnlijk, daar ben ik een backslash vergeten (tussen de lege aanhalingstekens).

 

[snb]

Svp niet citeren/quoten.

Maakt het alleen maar eenvoudiger

Sub M_snb()
  with Sheets("gegevens werknemer").Range("Z1")
    CreateObject("shell.application").Namespace(Environ("userprofile")).NewFolder "Documents\P&O\" & .Value
    ActiveWorkbook.SaveAs  Environ("userprofile") & "\Documents\P&O\" & .Value  &  "\" & .value & ".xlsm"
  end with
End Sub

NB. als je de code begrijpt kun je hem zelf aanpassen.

 

[jkpieterse]

Even gecorrigeerd:

Sub OpslaanAls()
    Dim sPad As String
    sPad = "C:\Users\" & Environ("Username") & "\Documents\P&O"
    If Len(Dir(sPad, vbDirectory)) = 0 Then
        MkDir sPad
    End If
    sPad = sPad & "\" & Sheets("gegevens werknemer").Range("Z1").Value
    If Len(Dir(sPad, vbDirectory)) = 0 Then
        MkDir sPad
    End If
    
    ActiveWorkbook.SaveAs Filename:=sPad & "" & Sheets("gegevens werknemer").Range("Z1").Value & ".xlsm"
    MsgBox "Dossier succesvol opgeslagen."
End Sub

 

[krampit]

Dan voor de moeite jkpieterse.

Het opslaan an sich werkt nu wel inderdaad, echter wordt het bestand opgeslagen met de dubbele waarde van cel Z1. Dus als Z1 = test123, dan wordt het bestand opgeslagen als test123 test 123. De map aanmaken gaat overigens wel goed, echter staat het bestand dan nog niet in de map. Dit moet handmatig er naartoe gesleept worden, ook geen groot probleem, maar niet helemaal zoals ik het graag zou willen.

 

[edmoor]

Waarschijnlijk omdat het rode teken nog mist:

ActiveWorkbook.SaveAs Filename:=sPad & "[COLOR="#FF0000"]\[/COLOR]" & Sheets("gegevens werknemer").Range("A1").Value & ".xlsm"

 

[krampit]

Heb ik aangepast Edmoor. Wordt nu aangegeven:

"Fout 1004 tijdens opsporing Microsoft Office kan geen toegang krijgen tot het bestand C:\Users\mark-\Documents\P&O\Test,T.\A6D39440. Er zijn verschillende mogelijke oorzaken...."

Waar komt die A6D39440 zo ineens vandaan dan?

 

[edmoor]

Maak er eens dit van:

ActiveWorkbook.SaveAs Filename:=sPad & "\" & Sheets("gegevens werknemer").Range("A1").Value & ".xlsm"[COLOR="#FF0000"], FileFormat:=52[/COLOR]

 

[krampit]

Same problem. Nu is het geen A6D39440, maar 2C3A9440.

 

[edmoor]

Plaats je document eens want zo blijft het speculeren.

 

[krampit]

Bekijk bijlage Helpmij.xlsxBekijk bijlage Helpmij.xlsx

Volstaat dit?

 

[edmoor]

In Z1 staat Test, T.
Die . wordt niet meegenomen bij het aanmaken van de map.
Alles lijkt dan in orde maar de naamgeving klopt dan niet meer.
Haal dus die . uit B6 weg of zet een letter of een woord in B5.

 

[krampit]

Holy ****, het werkt gewoon! Het zit 'm in het tussenvoegsel (B5). Dan iedereen z'n tussenvoegsel maar afschaffen

 

[edmoor]

Dat zei ik dus
Een mapnaam mag niet eindigen op een punt.