Отправить электронное письмо с добавленным диапазоном в тело письма в VBA Excel

Question

Мне нужно отправить электронное письмо, содержащее таблицу в теле письма, скопированную из таблицы фильтров, имя таблицы фильтров "ds" в этом коде, и я использую функцию RangetoHTML (код ниже), но она только копируетформат, а не содержимое таблицы, как показано ниже:

Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
Dim cell As Range
Dim Signature As String
Dim ds As Range

Set rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
For Each cell In rng
rw = cell.Row
If cell.Value <> "" Then
EmailSendTo = cell.Value
Nme = cell.Offset(0, 3).SpecialCells(xlCellTypeVisible)
xCC = cell.Offset(0, 1)
att = cell.Offset(0, 4).Value
EmailSubject = cell.Offset(0, 2)
lr1 = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
Sheet3.Range("A1:N" & lr1).AutoFilter field:=6, Criteria1:=Sheet4.Range("F2").Value
    lr = Sheet3.Cells(Sheet3.Rows.Count, 1).End(xlUp).Row
    Set ds = Sheet3.Range("A1:N" & lr).SpecialCells(xlCellTypeVisible)

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(o)
With OutMail
.Display
End With
Signature = OutMail.HTMLBody
'On Error Resume Next
With OutMail
.Subject = EmailSubject
.To = EmailSendTo
.CC = xCC
'.Body = MailBody
.HTMLBody = RangetoHTML(ds) 
.Display
.send
End With

Set OutMail = Nothing
Set OutApp = Nothing
MailBody = ""
End If
With Application
    .EnableEvents = 1
    .Calculation = xlCalculationAutomatic
End With
    Set OutMail = Nothing: Set OutApp = Nothing

Next
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:=xlPasteAll
        .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 

Я надеюсь, что какое-то тело поможет мне скопировать таблицу фильтра, содержащую полный контент, в основное письмо.