Dir maken

[don42]

Hallo allemaal wie kan mij helpen?
Ik heb een sheet waar ik een pdf van maak en dan gelijk kan mailen via outlook
nu had ik graag dat er aparte mapje gemaakt worden

bestandnaam = Sheets("rooster op naam").Range("a2").Value & ".pdf"
MkDir "C:\Users\Don\Desktop\& bestandnaam\"

bovenstaande regel maakt op mijn bureaublad de map & bestandsnaam en zet daar keurig de pdf in met de bestandsnaam uit a2
ik had graag dat er een map werd aangemaakt met ook de waarde uit cel a2
zou ik later nog een pdf maken met een gelijke waarde in A2 moet het in de zelfde map komen
is zoiets mogelijk?

Don

 

[Joske2000]

Zoiets ?
Niet getest !

MkDir "C:\Users\Don\Desktop\" & Cells(2, 1) & " bestandnaam\"

Joske

 

[HSV]

Met foutafhandeling.

bestandnaam = "C:\Users\Don\Desktop\" & Sheets("rooster op naam").Range("a2").Value & ".pdf"
 If Dir(bestandnaam, vbDirectory) = vbNullString Then MkDir bestandnaam

 

[don42]

Oke waar gaat het nu fout
probeer de regel van HSV
maar nu zit ik vast hier mis: ChDir "C:\Users\Don\Desktop\& bestandnaam\"

Private Sub CommandButton1_Click()
'Range("T8").Value = Sheets("Chauffeurs ").Range("M18")
Dim bestandnaam As String
bestandnaam = Sheets("rooster op naam").Range("a2").Value & ".pdf"
If Dir(bestandnaam, vbDirectory) = vbNullString Then MkDir bestandnaam

ChDir "C:\Users\Don\Desktop\& bestandnaam\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Don\Desktop\& bestandnaam\", OpenAfterPublish:=True

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object

Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments

With OutLookMailItem
.To = Range("t8")
.Subject = "Winter-Roulering op naam"
.Body = "Beste " & Range("a2") & " in de bijlage je rooster op naam (Winter Roulering)."
myAttachments.Add "C:\Users\Don\Desktop\& bestandnaam\"

'.send
.Display
End With

Set OutLookMailItem = Nothing
Set OutLo

 

[HSV]

De positie van de dubbele quotes.

 

[don42]

Maar dit maakt geen Dir

Private Sub CommandButton1_Click()
Dim bestandnaam As String
bestandnaam = Sheets("rooster op naam").Range("a2").Value & ".pdf"
If Dir(bestandnaam, vbDirectory) = vbNullString Then MkDir bestandnaam

ChDir "C:\Users\Don\Desktop\& bestandnaam"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Don\Desktop\& bestandnaam", OpenAfterPublish:=True

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object

Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments

With OutLookMailItem
.To = Range("t8")
.Subject = "Winter-Roulering op naam"
.Body = "Beste " & Range("a2") & " in de bijlage je rooster op naam (Winter Roulering)."
myAttachments.Add "C:\Users\Don\Desktop\& bestandnaam"

'.send
.Display
End With

Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub

 

[HSV]

Ik zie ook nog steeds een ander schrijfwijze als aangedragen door mij.

 

[don42]

Voor te beginnen
sorry ik zit van alles te proberen en maak het alleen maar onduidelijker zo is niet te werken

Private Sub CommandButton1_Click()
'Range("T8").Value = Sheets("Chauffeurs ").Range("M18")
Dim bestandnaam As String
bestandnaam = Sheets("rooster op naam").Range("a2").Value & ".pdf"

ChDir "C:\Users\Don\Desktop\roosters\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Don\Desktop\roosters\" & bestandnaam, OpenAfterPublish:=True

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object

Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments

With OutLookMailItem
.To = Range("t8")
.Subject = "Winter-Roulering op naam"
.Body = "Beste " & Range("a2") & " in de bijlage je rooster op naam (Winter Roulering)."
myAttachments.Add "C:\Users\Don\Desktop\roosters\" & bestandnaam

'.send
.Display
End With

Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub

met boven staande code en al een mapje rooster op mijn bureaublad krijg ik keurig een pdf in de map roosters
het liefst had ik dat in de map rooster een nieuwe map wordt gemaakt met de naam van cel a2 en dat in die map de pdf komt met de gelijke naam
ook moet die pdf als bijlage in de mail
bovenstaande werkt nu prima. vind het net iets mooier en overzichtelijker als er meer mappen worden aangemaakt, krijg anders meer als 300 pdf bestandjes in een map

met jou regel wordt de dir mooi aangemaakt
maar hoe verwijs ik weer naar dit adres?

 

[edmoor]

Eerst dit voor de mapnaam:

bestandnaam = Environ("USERPROFILE") & "\Desktop\roosters\" & Sheets("rooster op naam").Range("A2").Value
 If Dir(bestandnaam, vbDirectory) = vbNullString Then MkDir bestandnaam

Daarna dit voor de naam en plaats van het PDF bestand:

bestandnaam = bestandnaam & "\" & Sheets("rooster op naam").Range("A2").Value & ".pdf"

 

[don42]

oke...
ga het even proberen

Met onderstaande code maakt hij in de map rooster een nieuwe map aan met de juiste naam
en daar komt een ONWAAR.pdf in te staaan (is wel het goede bestand maar de verkeerde naam)
en geen bijlage in de mail
waar moet nog wat aangepast?

Private Sub CommandButton1_Click()
'Range("T8").Value = Sheets("Chauffeurs ").Range("M18")
Dim bestandnaam As String
'bestandnaam = Sheets("rooster op naam").Range("a2").Value & ".pdf"


bestandnaam = Environ("USERPROFILE") & "\Desktop\roosters\" & Sheets("rooster op naam").Range("A2").Value
 If Dir(bestandnaam, vbDirectory) = vbNullString Then MkDir bestandnaam


ChDir "C:\Users\Don\Desktop\roosters\" & Sheets("rooster op naam").Range("A2").Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Don\Desktop\roosters\" & bestandnaam = bestandnaam & "\" & Sheets("rooster op naam").Range("A2").Value & ".pdf", OpenAfterPublish:=True



Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object

Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments

With OutLookMailItem
.To = Range("t8")
.Subject = "Winter-Roulering op naam"
.Body = "Beste " & Range("a2") & " in de bijlage je rooster op naam (Winter Roulering)."
myAttachments.Add "C:\Users\Don\Desktop\roosters\" & bestandnaam & "\" & Sheets("rooster op naam").Range("A2").Value & ".pdf"

'.send
.Display
End With

Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub

 

[HSV]

Private Sub CommandButton1_Click()
Dim bestandnaam As String
bestandnaam = Environ("USERPROFILE") & "\Desktop\roosters\" & Sheets("rooster op naam").Range("A2").Value
 If Dir(bestandnaam, vbDirectory) = vbNullString Then MkDir bestandnaam
    ActiveSheet.ExportAsFixedFormat 0, bestandnaam & "\" & Sheets("rooster op naam").Range("A2").Value & ".pdf", , , , , , True
With CreateObject("Outlook.application").CreateItem(0)
    .To = Range("t8")
    .Subject = "Winter-Roulering op naam"
    .Body = "Beste " & Range("a2") & " in de bijlage je rooster op naam (Winter Roulering)."
    .Attachments.Add bestandnaam & "\" & Sheets("rooster op naam").Range("A2").Value & ".pdf"
     '.send
    .Display
 End With
End Sub

 

[don42]

Bedankt top