VBA komplettes Tabellenblatt im Outlook E-Mail Body einfügen

[Excel_vba]

Hallo Zusammen,

ich bin neu hier und totaler VBA Anfänger. Wir haben einen Report mit unten stehender VBA:

Mit Ausführen des Makros wird eine E-Mail mit Anhang erstellt. Im Anhang ist eine Excel Auswertung hinterlegt.

Ich möchte jedoch das die Auswertung nicht als Anhang in der E-Mail beigefügt wird. Sondern das komplette Tabellenblatt in dem E-Body eingefügt wird (inkl. Tabelle / Formatierung, Farben usw.). Nicht im HTML Format.

Wie und an welcher Stelle kann ich das Makro ändern sodass die Auswertung im E-Mail Body und nicht als Anhang beigefügt wird?

Würde mich sehr um Hilfe freuen.

Danke und Grüße 


Option Explicit

Sub WorksheetinNewWorkbook()
 
    Dim FName           As String
    Dim FPath           As String
    Dim NewBook         As Workbook
    Dim NewBook_Name    As String
 
    FPath = ThisWorkbook.Path
    FName = "Auswertung - " & Format(Date, "ddmmyy") & ".xlsx"
     
    ThisWorkbook.RefreshAll
 
    If Dir(FPath & "\" & FName) <> "" Then
        MsgBox "File " & FPath & "\" & FName & " existiert bereits"
    Else
        Set NewBook = Workbooks.Add
       
        ThisWorkbook.Sheets("Ergebnis").Copy Before:=NewBook.Sheets(1)
       ' ThisWorkbook.Sheets(" Summe").Copy After:=NewBook.Sheets(1)
        NewBook.SaveAs Filename:=FPath & "\" & FName
       
        Workbooks(FName).Close SaveChanges:=True
       
        Call EmailMe(FPath & "\" & FName)
       
        Kill FPath & "\" & FName
    End If
 
End Sub

-----------

 Sub EmailMe(Filename As String)
   
    Dim mail                    As Object
    Dim msg                     As Object
    Dim wks_Email_Adressen      As Worksheet
    Dim lRow_B                  As Long
    Dim lRow_C                  As Long
    Dim strTo                   As String
    Dim strCC                   As String
    Dim i
   
    'Find the last non-blank cell in column A(1)
    Set wks_Email_Adressen = ThisWorkbook.Sheets("E_Mail_Adressen")
    lRow_B = wks_Email_Adressen.Cells(Rows.Count, 2).End(xlUp).Row
    lRow_C = wks_Email_Adressen.Cells(Rows.Count, 3).End(xlUp).Row
   
    Set mail = CreateObject("Outlook.Application")
    Set msg = mail.createitem(0)
   
     With msg
        For i = 6 To lRow_B
            strTo = strTo & ";" & wks_Email_Adressen.Range("B" & i)
        Next i
            .To = strTo
           
        For i = 6 To lRow_C
            strCC = strCC & ";" & wks_Email_Adressen.Range("C" & i)
        Next i
            .CC = strCC
               
        .Subject = "Auswertung - " & Format(Date, "ddmmyy")
        .body = "Sehr geehrte Damen und Herren, " & vbNewLine & vbNewLine & _
                "anbei erhalten Sie die Auswertung. "
               
        .Attachments.Add Filename, 1, 1 ', "Test"
        .display
     
     End With
   
    End Sub