Marko Laufzeitfehler 1004

Sub EmailErzeugen()
Dim app   As Object
Dim file  As String
Dim isNew As Boolean
Dim olAPP As Object
Dim olOldBody As String
Dim signature As String
file = Sheets("Daten").Range("AG5").Text & ".pdf"
Sheets("Daten").Range("A1:G100").ExportAsFixedFormat xlTypePDF, Environ("TEMP") & "\" & file
On Error Resume Next
Set app = GetObject(, "Outlook.Application")
If app Is Nothing Then
Set app = CreateObject("Outlook.Application")
isNew = True
End If
With app.CreateItem(0)
.GetInspector.Display
.To = Sheets("Daten").Range("AE7").Value
.CC = Sheets("Daten").Range("AE6").Value & ";" & Sheets("Daten").Range("AE8").Value & ";" & Sheets("Daten").Range("AE9").Value
.BCC = ""
.Subject = Sheets("Daten").Range("E4").Value
.htmlbody = "" _
& Sheets("Daten").Range("AH6") _
& "

" & Sheets("Daten").Range("AH7") _
& "

" & Sheets("Daten").Range("AH8") _
& "

" & Sheets("Daten").Range("AH9") _
& "



	Bewerten Sie hier bitte das Excel-Portal
	

	

" & .htmlbody
.GetInspector.Display
.strSignatur = .body
.Attachments.Add Environ("TEMP") & "\" & file
.ReadReceiptRequested = True
.Display
End With
If isNew Then app.Quit
End Sub