Example where you can choose the mode as HTML or image:
Code
Sub Envia_Email()
Dim modo As String
'Escolhe modo ou "html" ou "imagem"
'modo = "html"
modo = "imagem"
Application.DisplayAlerts = False 'desabilite o alerta
Dim email_envio As String, email_copia As String
Dim Contatos As Worksheet, Conteudo As Worksheet
Set Contatos = ThisWorkbook.Worksheets("Planilha2")
Set Conteudo = ThisWorkbook.Worksheets("Planilha3")
email_envio = Contatos.Range("A1") 'e-mail para qual será enviado
email_copia = Contatos.Range("A2")
descricao = Conteudo.Name
'https://stackoverflow.com/a/48496434/7690982
Dim rng As Range, cell As Range, HtmlContent As String, i As Long, j As Long
'Intervalo da tabela que vai anexada
Set rng = Conteudo.Range("D5:K13")
'Debug.Print rng.Address 'Verifica o endereço
'Verifica o modo
If modo = "html" Then
HtmlContent = RangetoHTML(rng)
ElseIf modo = "imagem" Then
rng.CopyPicture xlScreen, xlPicture
Set temp = Sheets.Add
temp.Shapes.AddChart
temp.Shapes.Item(1).Select
Set objChart = ActiveChart
With objChart
.ChartArea.Height = rng.Height
.ChartArea.Width = rng.Width
.ChartArea.Fill.Visible = msoFalse
.ChartArea.Border.LineStyle = xlLineStyleNone
.Paste
imagem_temp = "temp"
.Export Filename:=imagem_temp, FilterName:="JPG"
End With
temp.Delete
HtmlContent = "<br><img src=" & "'" & imagem_temp & "'/><br>"
Else
MsgBox "Modo inválido"
End If
'https://stackoverflow.com/a/15161351/7690982
Dim OApp As Object, OMail As Object
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
With OMail
.Display
End With
Signature = OMail.HTMLbody
With OMail
Introducao = "Prezado, bom dia!.<br>Segue a tabela:" 'Texto Intro Corpo do e-mail
.To = email_envio
.Cc = email_copia 'Quem será copiado
.Subject = "Assunto " & descricao 'Assunto do e-mail
'.Attachments.Add 'Adiciona anexos
.HTMLbody = Introducao & vbNewLine & HtmlContent & vbNewLine & Signature
.Send
End With
Set OMail = Nothing
Set OApp = Nothing
If modo = "imagem" Then Kill imagem_temp
Application.DisplayAlerts = True 'habilite o alerta
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
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 xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
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
'Read all data from the htm file into RangetoHTML
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=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
See the following answers: email range + signature and Generate a file and attach in the email with vba
– danieltakeshi
This is because you use Sendkeys to copy and paste the email. Then you use the keyboard to accomplish this task. The correct would be either attach to the email or paste as an image in the email. Or in the above links to send as html table or attach the entire workbook.
– danieltakeshi
I get it. I’ll try to adapt to use as an HTML table. Thank you.
– Vinícius Batista