PDF automatisch als E-Mail-ANhang versenden

Private Sub CommandButton1_Click()
Dim xOutApp As Object
Dim xOutMail As Object
Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
'** Pfad für temporäre Zwischenspeicherung angeben
strPfad = "C:\Temp" 'entsprechend anpassen
'** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt = ActiveSheet.Name
'** Gewähltes Tabellenblatt kopieren
Sheets(strBlatt).Copy
Application.DisplayAlerts = False
'** Blatt temporär in vorgegebenes Verzeichnis abspeichern
ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name
Application.DisplayAlerts = True
'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = ActiveWorkbook.FullName
With xOutMail
.GetInspector
.To = "?@xxx.de"
.CC = ""
.BCC = ""
.Subject = "Übersicht"
.Attachments.Add strDatei
.HTMLBody = "Hallo, 

dies  _
ist ein Test." & .HTMLBody
.Display   'or use .Send
End With
'** Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close
'** Erzeugte Datei wieder löschen
Kill (strDatei)
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub