Sub Datei_als_XLSX_danach_versenden()
Dim Ordnerpfad As Variant
Dim filepath As String, Pfad As String, Dateiname As String, AktiveMappe As Workbook
Dim closefile As String, closefilename As String
Dim OutApp As Object
Dim Textkopf As Object
Dim Text As String, Anrede As String, Grusswort As String
Dim Strbody As String, Gesamtertext As String
Dim Mailadresse As String, Betreff As String
Dim Anhang As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set AktiveMappe = ActiveWorkbook
filepath = AktiveMappe.FullName
Pfad = AktiveMappe.Path
Datum = Format(Now, "_dd.mm.yyyy_hh_mm_ss")
Dateiname = AktiveMappe.Name
If InStr(Dateiname, ".") > 0 Then
Dateiname = Left(Dateiname, InStr(Dateiname, ".") - 1)
End If
closefile = Pfad & "\" & Dateiname & Datum & "_Backup.xlsx"
closefilename = Dateiname & Datum & "_Backup.xlsx"
AktiveMappe.Save
AktiveMappe.SaveAs Filename:=closefile, FileFormat:=51
Application.Workbooks.Open (filepath)
Workbooks(closefilename).Close SaveChanges:=False
Anhang = closefile
Mailadresse = "Beispiel@Beispiel.de"
Betreff = Dateiname & Datum & "_Backup"
Anrede = "Guten Tag<br><br>"
Text = "Exceldatei "
Grusswort = "Gruss"
Gesamtertext = Anrede & Text & " " & Dateiname & "<br><br>" & Grusswort
Set Textkopf = OutApp.CreateItem(olMailItem)
With Textkopf
.Recipients.Add Mailadresse
.Subject = Betreff
.HTMLBody = Gesamtertext
.Attachments.Add Anhang
.Display
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub