Excel Makro, PDF versenden, Anhang klappt nicht?
Hallo, ich würde gerne eine Rechnung mit einem Makro erstellen. Soweit klappt das auch und die Mail öffnet sich auch, aber diese wird nicht als Anhang hinzugefügt. Ich komme leider nicht drauf. Ich denke, es liegt daran, dass er die Datei nicht findet, aber ich wüsste keinen Lösungsansatz. Hier der Code:
Dim Result As VbMsgBoxResult
Sub RechnungsnrUndDrucken()
Sheets("Rechnung_Video").Select
[D15] = [D15] + 1 'Rechnungsnummer 1 hochzählen
Dim sCC As String
Dim sName As String
Dim sText As String
Dim sObject As String
Dim sCompany As String
Dim sRefNr As String
Dim sTempFileName As String
If (CStr(ThisWorkbook.ActiveSheet.Name) = "Rechnung") Then
Result = MsgBox("Rechnung fertig?", vbApplicationModal Or vbQuestion Or vbYesNo)
If Result = vbNo Then Exit Sub
End If
Const DateiPfad = "C:\Temp\"
Dim DateiName As String
DateiName = DateiPfad & Range("C15") & Range("D15") & ".pdf"
Range("A1:F54").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
DateiName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Dim Nachricht As Object, OutApp As Object
Dim AWS As String
Set OutApp = CreateObject("Outlook.Application")
AWS = strFileName
'InitializeOutlook = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.Subject = "" & Range("A1") & "_" & Range("C15") & Range("D15")
.GetInspector.display
'.Attachments.Add ("C:\Temp\" & Range("C15") & Range("D15") & ".pdf")
End With
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub
1 Antwort
Hast du denn mal probiert die 2 Aufgaben in 2 Makro zu verpacken und nacheinander auszuführen? Also erst mal pdf erstellen und dann verschicken? Evtl. ist das Makro ja "schneller" als das pdf erstellt wird?
Sollte es jemand brauchen. Diser Code hat funkltioniert in einem Makro:
Dim Result As VbMsgBoxResult
Sub RechnungsnrUndDrucken()
Sheets("Rechnung_Video").Select
[D15] = [D15] + 1 'Rechnungsnummer 1 hochzählen
Dim sCC As String
Dim sName As String
Dim sText As String
Dim sObject As String
Dim sCompany As String
Dim sRefNr As String
Dim sTempFileName As String
If (CStr(ThisWorkbook.ActiveSheet.Name) = "Rechnung") Then
Result = MsgBox("Rechnung fertig?", vbApplicationModal Or vbQuestion Or vbYesNo)
If Result = vbNo Then Exit Sub
End If
Range("a1:f54").Select
strFileName = "C:\Temp\" & Range("A1") & ("_") & Range("C15") & Range("D15") & (".pdf")
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Dim Nachricht As Object, OutApp As Object
Dim AWS As String
Set OutApp = CreateObject("Outlook.Application")
AWS = strFileName
'InitializeOutlook = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "" & Range("G9")
.Cc = "" & Range("G10")
'Empfänger
.Subject = "" & Range("A1") & "_" & Range("C15") & Range("D15")
'Betreff, Name, Datum
.GetInspector.Display ' sorgt für die Signatur
.Display
.Attachments.Add AWS
Kill AWS
End With
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub
Werd ich mal probieren. Danke für den Tipp.
Entschuldige die Frage, aber siehst du ob ich vill. einen Fehler in meinem Makro habe, oder ergibt das alles so eigentlich Sinn?