Mail mit Anhang senden

Sub ExcelMailsenden()
ChDir ThisWorkbook.Path 'anpassen 'oder thisworkbook.path
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Sheets("1. Mängelanzeige").Range("i1").Value & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.createItem(0)
With objMail
.GetInspector     ' sorgt für die Signatur
.To = Sheets("1. Mängelanzeige").Range("A4").Value
.CC = Sheets("1. Mängelanzeige").Range("A5").Value
.BCC = Sheets("1. Mängelanzeige").Range("A6").Value
.Subject = ThisWorkbook.Worksheets("1. Mängelanzeige").Range("i1")
.body = Sheets("1. Mängelanzeige").Range("k43").Value & .body
.Display        'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend  _
manuell vom User!
MsgBox ("Bitte Datei auswählen.")
Set fdOpen = Application.FileDialog(msoFileDialogOpen)
With fdOpen
.AllowMultiSelect = True
.InitialView = msoFileDialogViewList
.InitialFileName = ActiveWorkbook.Path
.Title = "Bitte die zu sendende(n) Datei(en) auswählen!"
.ButtonName = "per E-Mail senden"
If .Show = True Then
Dim i As Integer
If .SelectedItems.Count > 0 Then
For i = 1 To .SelectedItems.Count
Mail.attachments.Add .SelectedItems(i)
Next
End If
End If
End With
End With
SendKeys body
End Sub