Send email outlook with table on body

Sub SendEmail()
    Dim rng As Range, OutApp As Object, OutMail As Object
    Dim sCC As String, sSubj As String, sEmAdd As String
    
    '// Change the values of these variables to suit
    sEmAdd = "[email protected]"
    sCC = ""
    sSubj = "My Subject"
    
    Set rng = Nothing
    On Error Resume Next
    Set rng = ActiveSheet.Cells(1).CurrentRegion
    On Error GoTo 0


    With Application
        .EnableEvents = 0
        .ScreenUpdating = 0
        .Calculation = xlCalculationManual
    End With
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        .To = sEmAdd
        .CC = sCC
        .Subject = sSubj
        .HTMLBody = RangetoHTML(rng)
        .Send '// Change this to .Display if you want to view the email before sending.
    End With
    On Error GoTo 0


    With Application
        .EnableEvents = 1
        .Calculation = xlCalculationAutomatic
    End With
    Set OutMail = Nothing: Set OutApp = Nothing
    
End Sub


Function RangetoHTML(rng As Range)
    Dim fso As Object, ts As Object, TempWB As Workbook, TempFile As String


    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteColumnWidths, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")


    TempWB.Close 0
    Kill TempFile


    Set ts = Nothing: Set fso = Nothing: Set TempWB = Nothing
    
End Function

Sub SendEmail()




    Dim SendingRng As Range
    On Error GoTo StopMacro
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With




    Set SendingRng = Worksheets("Sheet1").Range("A1:d4")




    With SendingRng




        .Parent.Select
        .Select




        ' Create the mail and send it
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope




            .Introduction = "This is test mail."




            With .Item
                .To = "[email protected]"
                .CC = ""
                .BCC = ""
                .Subject = "My subject"
                .Send
            End With




        End With




    End With
StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False




End Sub