VBA Speichern als Pdf mit Datum-Uhrzeit, dann öffnet Outlook
05.02.2025 11:34:02
Jürgen.W
Ich habe ein funktionierendes Makro, in den das Blatt einmal gedruckt, zwei mal an verschiedenen Orten als PDF gespeichert wird, dann eine neue Mail öffnet, in dem die Mailadresse, eine Anschreiben und eine PDF angefügt ist. Das klappt alles super.
Nun möchte ich die PDFs mit Datum und Uhrzeit speichern. Dazu habe ich & Format(Now, "yyyy.mm.dd_hh.nn") eingegeben. Dann öffnet sich aber das Mailfenster nicht mehr, bzw. nach mehreren Minuten taucht es in Entwürfe ohne Anhang auf. Also ganz seltsam.
Ich muss dazu sagen, ich habe mir das alles "zusammengebastelt", was dann bisher auch super lief, nur mit dem Datum/Uhrzeit bekomme ich einfach nicht hin.
Sub Mailversand()
Application.ActivePrinter = "\\AD-Daten-01\Drucker-SW auf Ne07:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("A1") & " " & ActiveSheet.Range("A3") & " " & ActiveSheet.Range("B23") & Format(Now, "yyyy.mm.dd_hh.nn") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
On Error GoTo ErrHandler
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"K:\Bestellungen\" & ActiveSheet.Range("B23") & " " & ActiveSheet.Range("A1") & " " & ActiveSheet.Range("A3") & Format(Now, "yyyy.mm.dd_hh.nn") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
On Error GoTo ErrHandler
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
a = customerContact
b = salesExec
Dim Ebody As String
Ebody = "placeholder"
Ebody = "Sehr geehrte Damen und Herren," & "
" & _
"anbei erhalten Sie eine Bestellung zum o. g. Bauvorhaben mit Bitte um Bestätigung."
With OutMail
.GetInspector ' ## This inserts default signature
Signature = .HTMLBody ' ## Capture the signature HTML
.To = Range("A8").Value
.Subject = "Bestellung" & " " & Range("A1").Value & ": " & "Bauvorhaben" & " " & Range("B23").Value & ", " & Range("D23").Value & " " & Range("E23").Value
.HTMLBody = "" _
& Ebody _
& "
" _
& Signature
.Attachments.Add (ThisWorkbook.Path & "\" & ActiveSheet.Range("A1") & " " & ActiveSheet.Range("A3") & " " & ActiveSheet.Range("B23") & ".pdf")
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
ErrHandler:
End Sub
Es wäre super, wenn mir jemand helfen könnte. Über die Suche habe ich nichts passendes gefunden.
Schöne Grüße aus Nordhorn
Anzeige