Sub xxxx_senden()
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)
strPfad = "C:\Temp"
strBlatt = ActiveSheet.Name
Sheets(strBlatt).Copy
ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name & "_" & Format(Now(), "DD.MM.YYYY") & ".xlsx"
Application.ScreenUpdating = False
strDatei = ActiveWorkbook.FullName
strbody = "<font face=Arial>Sehr geehrter Damen und Herren,</font><br><br>" & _
"<font face=Arial>im Anhang finden Sie die aktuelle FO Liste."
With Mail
.GetInspector.Display
.To = Worksheets("Mail").Range("D26")
.Subject = "Aktuelle FO Liste_" & Format(Date, "DD.MM.YYYY")
.HTMLBody = strbody & "<br>" & .HTMLBody
.Attachments.Add strDatei