1
Sub EnviarEmailComPlanilha()
2
    Dim OutlookApp As Object
3
    Dim OutlookMail As Object
4
    Dim rng As Range
5
    Dim sht As Worksheet
6
    Dim strBody As String
7
    Dim LastRow As Long
8
 
9
    ' Defina a planilha e o intervalo que você deseja copiar
10
    Set sht = ThisWorkbook.Sheets("NomeDaSuaPlanilha") ' Substitua pelo nome da sua planilha
11
    LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row ' Encontra a última linha preenchida na coluna A
12
    Set rng = sht.Range("A1:D" & LastRow) ' Ajuste o intervalo conforme necessário
13
 
14
    ' Converte o intervalo selecionado em HTML
15
    strBody = RngToHTML(rng)
16
 
17
    ' Inicia o Outlook e cria um novo e-mail
18
    Set OutlookApp = CreateObject("Outlook.Application")
19
    Set OutlookMail = OutlookApp.CreateItem(0)
20
 
21
    ' Preenche o e-mail
22
    With OutlookMail
23
        .To = "[email protected]" ' Substitua pelo endereço de e-mail do destinatário
24
        .CC = ""
25
        .BCC = ""
26
        .Subject = "Assunto do Email"
27
        .HTMLBody = strBody
28
        .Display ' Para exibir o e-mail antes de enviar, use .Display; para enviar diretamente, use .Send
29
    End With
30
 
31
    ' Limpeza
32
    Set OutlookMail = Nothing
33
    Set OutlookApp = Nothing
34
End Sub
35
 
36
Function RngToHTML(rng As Range)
37
    ' Função para converter o intervalo em HTML
38
    Dim fso As Object
39
    Dim ts As Object
40
    Dim TempFile As String
41
    Dim TempWB As Workbook
42
 
43
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
44
 
45
    ' Copia o intervalo para uma nova planilha temporária
46
    rng.Copy
47
    Set TempWB = Workbooks.Add(1)
48
    With TempWB.Sheets(1)
49
        .Cells(1, 1).PasteSpecial Paste:=8
50
        .Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
51
        .Cells(1, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
52
        .Cells(1, 1).Select
53
        Application.CutCopyMode = False
54
    End With
55
 
56
    ' Salva a nova planilha como arquivo HTML temporário
57
    With TempWB.PublishObjects.Add( _
58
         SourceType:=xlSourceRange, _
59
         Filename:=TempFile, _
60
         Sheet:=TempWB.Sheets(1).Name, _
61
         Source:=TempWB.Sheets(1).UsedRange.Address, _
62
         HtmlType:=xlHtmlStatic)
63
        .Publish (True)
64
    End With
65
 
66
    ' Lê o arquivo HTML temporário para uma string
67
    Set fso = CreateObject("Scripting.FileSystemObject")
68
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
69
    RngToHTML = ts.ReadAll
70
    ts.Close
71
 
72
    ' Limpeza
73
    Set ts = Nothing
74
    Set fso = Nothing
75
    TempWB.Close SaveChanges:=False
76
    Set TempWB = Nothing
77
    Kill TempFile
78
End Function