Excel Makro zum Email Versand aus Vorlagen-Excel

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:\Data" '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
'** Mail erzeugen
With Mail
.to = Worksheets("Einmeldung").Range("B10").Text
.cc = "ideenzirkel@smw.at"
.Subject = "Einmeldung Ideenzirkel" 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = "Text" '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