|
Hallo Zusammen
Ich "versuche" ein Makro zu erstellen bei dem ich Informationen aus einem Programm in eine Exceldatei (*.xltm) bekomme.
Im Anschluss möchte ich eine PDF erstellen und dies an eine Adresse senden.
Die gesendte Mail soll im Anschluss unter einem Pfad abgespeichert werden.
Das erstellen der PDF und der Mail und Versand funktionieren Problemlos
Leider bekomme ich beim Abspeichern der Mail eine Fehlermeldung
Laufzeitfehler 424
Objekt erforderlich
Hier einmal der Quelltext
Ich habe wirklich keine Ahnung an was es noch liegen kann
Sub Schaltfläche2_Klicken()
Dim strMailAdresse As String
Dim LKNR As String
'Empfaengermailadresse holt Sie sich von Zelle B33 auf Blatt QSYS
strMailAdresse = Worksheets("QSYS").Range("B33").Value
'LK-Nr holt Sie sich von Zelle B4 auf Blatt QSYS
LKNR = Worksheets("QSYS").Range("B4").Value
'PDF erstellen!!! / Wird nur Temporaer abgelegt und am Ende wieder geloescht
Worksheets("DE").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\" & Environ("username") & "\AppData\Local\Temp\" & Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hh-mm") & "_Wareneingang.pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False
' Speicherpfad von PDF unter Temp Lokal
strPDF = "C:\Users\" & Environ("username") & "\AppData\Local\Temp\" & Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hh-mm") & "_Wareneingang_ZA.pdf"
'Mail erstellen
'Verwende Outlook
Set olApp = CreateObject("Outlook.Application")
'Erstellen der Mail
With olApp.CreateItem(0)
' Absendermail
.SentOnBehalfOfName = "test@test.de"
'Empfaengermailadresse holt Sie sich von Zelle B33 auf Blatt QSYS
.To = strMailAdresse
'Betreff LK-Nr & Bestätigung Wareneingang
.Subject = LKNR & " Bestätigung Wareneingang"
' haengt PDF als Anhang an
.Attachments.Add strPDF
' Mail Text in HTML Format, Zeilenfortsetzung hier verwendet fuer bessere Uebersicht
.HTMLBody = "<HTML> <font face=+Textkörper>For english see below <br>" _
& "<br> " _
& "************************************* <br>Sehr geehrter Kunde <br>" _
& "<br> " _
& "Hiermit bestätigen wir ihnen die Warenrücklieferung zur _
& "</font face> </HTML>"
.Display
'Falls gesendet werden soll: ".Display" entfernen und durch ".Send" ersetzen
'.Display
'.Send
End With
'PDF Datei loeschen
Kill strPDF
'Schliesst Outlook und gibt es wieder frei
Set olApp = Nothing
'Meldbox um Outlook Zeit zu geben, dass Mail im Ordner "gesendete Objekte" abliegen kann
MsgBox "Mail wurde versendet", vbOKOnly, "Mail versendet"
'ab hier soll gesendete Mail gespeichert werden
'speichert die letzte gesendete Mail unter dem Speicherpfad ab
Dim Speicherpfad As String
Dim o2App As Object, objMail As Object
'LK-Nr holt Sie sich von Zelle B4 auf Blatt QSYS
LKNR = Worksheets("QSYS").Range("B4").Value
'Speicherpfad; beim aenderen auf den letzen \ achten ;)
Speicherpfad = "C:\Ablageort\"
'verwende Outlook
Set o2App = GetObject(, "OutLook.Application")
'verwende die letzte gesendete Mail
Set objMail = o2App.Session.GetDefaultFolder(5).Items.GetLast
'Abspeichern unter dem Speicherpfad; Aufbau Dateiname: Datum-LKNr,
objMail.SaveAs Speicherpfad & Format(Date, "yyyy") & "_" & Format(Date, "mm") & "_" & Format(Date, "dd") & "_" & LKNR & ".msg", 3
'Meldbox zum testen
'MsgBox "Mail wurde gespeichert", vbOKOnly, "Mail gespeichert"
'Schliesst Outlook und gibt es wieder frei
'Set olApp = Nothing
'Schliesst diese Excel ohne zu speichern
ThisWorkbook.Close savechanges:=False
Application.Quit
End Sub
|