Einzelnes Tabellenblatt per E-Mail versenden

Sub einzelnes_Blatt_senden()
'** Das aktive Tabellenblatt wird über Outlook versendet
'** Dimensionierung der Variablen
Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.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
'** Blatt temporär in vorgegebenes Verzeichnis abspeichern
ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name

'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = ActiveWorkbook.FullName

'** Body-Text festlegen
strBodyText = _
"Mit freundlichen Grüßen" & Chr(13) & Chr(13) & _
"Alois Eckl" & Chr(13) & _
"Excel-Inside Solutions, Grabbestr. 25, 90427 Nürnberg" & Chr(13) & _
"Auftragsprogrammierung - Anwendungsentwicklung" & Chr(13) & _


'** Mail erzeugen
With Mail
'.To = ""
'.CC = ""
.Subject = "" 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With

'** Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close

'** Erzeugte Datei wieder löschen
Kill (strDatei)

'** E-Mail anzeigen
Mail.Display
End Sub