How to insert spreadsheet with images in the email body?

Question

I need to put a spreadsheet in the body of an email, but I’m not able to make the spreadsheet images are kept

Routine that creates the HTML file from the spreadsheet:

Private Function CriarHTML(Rng As Range)

Dim FSO     As Object
Dim TS      As Object
Dim Caminho As String

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Caminho = VBA.Environ("Temp") & VBA.Format(VBA.Now, "dd-mm-yyyy h-mm-ss") & ".html"

    With ThisWorkbook.PublishObjects.Add(SourceType:=xlSourceRange, Filename:=Caminho, Sheet:=wsPauta.Name, Source:=Rng.Address, HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    Set TS = FSO.GetFile(Caminho).OpenAsTextStream(1, -2)
    CriarHTML = TS.readall
    TS.Close

    'Alinhar a esquerda
    CriarHTML = VBA.Replace(CriarHTML, "align=center x:publishsource=", "align=left x:publishsource=")

End Function

---

Excerpt that puts the information in the email object:

With wsPauta
    R = .Cells(1048576, 3).End(xlUp).Row + 1
    Mensagem = Mensagem & "</B>" & CriarHTML(.Range(.Cells(10, 1), .Cells(R, 13))) & "<br><br>"
End With
With olMail
    .Subject = Titulo
    .To = Para
    .CC = CC
    .Display
    .HTMLBody = Mensagem & .HTMLBody
    .Attachments.Add NomeAnexo
End With