top of page

inscreva-se

  • YouTube ícone social

VBA!

Canal no Youtube criado por Amanda Nascimento 

Sem título.png
EXCEL
POWER QUERY
POWER PIVOT
OFFICE SCRIPT

ENVIAR E-MAIL PELO EXCEL

O app Microsoft Outlook deverá estar instalado e aberto na máquina.

Pontos relevantes:

  • No exemplo abaixo, o assunto, destinatário, CC e CCO inseri um inputbox para receber a informação. Uma outra opção é inserir o valor em uma célula específica, e fazer o VBA puxar de lá, desta forma:  Email.to = Cells(3, 11).Value, para isso, apague as declarações (Dim) até a última linha que inicia com "ThisWorkbook.Worksheets("Planilha1").Range("k5").Value = copiaoculta".

  • As linhas que se iniciam com ' o VBA não lê. Por tanto, considere opções de código que você poderá utilizar. 

  • Chr(10) 10 representa o enter, ou seja, pular uma linha. Utilize para montra o conteúdo do e--mail.

  • Para anexar arquivos, é necessário copiar o caminho exato que ele esta armazenado no seu computador. Se atente as extensões, por exemplo: .xlsx .pdf .jpeg, etc. 

  • Para enviar e-mail em massa insira ; entre os e-mails. Exemplo: Email.to = "amanda@gmail.com;xlsxtreinamentos@gmail.com"

Opção 1:

Insira um módulo:

Sub enviar_email()

Dim assunto As String
Dim destinatario As String
Dim copia As String
Dim copiaoculta As String

assunto = InputBox("Digite um assunto: ", "Enviar e-mail Outlook", "assunto")
destinatario = InputBox("Para quem? ", "Enviar e-mail Outlook", "destinatário")
copia = InputBox("C/C: ", "Enviar e-mail Outlook", "cópia")
copiaoculta = InputBox("C/CCO: ", "Enviar e-mail Outlook", "cópia oculta")

ThisWorkbook.Worksheets("Planilha1").Range("k2").Value = assunto
ThisWorkbook.Worksheets("Planilha1").Range("k3").Value = destinatario
ThisWorkbook.Worksheets("Planilha1").Range("k4").Value = copia
ThisWorkbook.Worksheets("Planilha1").Range("k5").Value = copiaoculta

Set objeto_outlook = CreateObject("Outlook.Application")

Set Email = objeto_outlook.createitem(0)

Email.display

 Email.to = Cells(3, 11).Value
'Email.cc = Cells(4, 11).Value
'Email.bcc = Cells(5, 11).Value


'ASSUNTO
    'Email.Subject = "Insira o assunto aqui"
     'Email.Subject = Cells(2, 11).Value
     
Email.Subject = Cells(2, 11).Value

 

'CORPO DO E-MAIL
'Chr(10) 10 representa o enter

Email.Body = Cells(3, 2).Value & "," & Chr(10) & Chr(10) _
& Cells(2, 3).Value & Chr(10) & Chr(10) _
& "Atenciosamente," & Chr(10) & "Amanda"


'---> ESCOLHER UMA OPÇÃO PARA ANEXAR:

'Email.Attachments.Add (ThisWorkbook.Path & "\Vendas - " & Cells(3, 2).Value & ".xlsx")
'Email.Attachments.Add (ThisWorkbook.Path & "\carta jabuda - " & Cells(3, 2).Value & ".pdf")
Email.Attachments.Add "R:\GESTAO DE PESSOAS\RH\CARGOS E REMUNERAÇÃO\38 - CENTRAL DE VAGAS\Top Performance.xlsx"


Email.send

End Sub

Opção 2:

  • Insira um módulo:

Para usar HTML, é necessário criar uma função na íntegra abaixo. Copie e cole o texto abaixo no arquivo que será disparado os e-mails:

Function RangetoHTML(rng As Range)

    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

  • Insira um novo módulo:

Sub enviar_email_tabela()

Set objeto_outlook = CreateObject("Outlook.Application")
Set Email = objeto_outlook.createitem(0)

Email.display

'Email.to = Cells(2, 1).Value
Email.to = "amanda@gmail.com"
Email.cc = ""
Email.bcc = ""

Email.Subject = " Assunto do seu e-mail aqui"

texto1 = "Oi " & Cells(2, 2).Value & "!<br><br>Conteúdo textual do seu e-mail aqui!<br><br>"

Email.htmlbody = texto1 & "<img src='C:\Users\caminho\Teste.png'>" _
& "<br><br>" _

'Apos texto1 & caminho da imagem, utilize apenas se você deseja anexar alguma imagem no corpo do e-mail. Caso contrário, apague. 

'Se a sua planilha tiver apenas uma aba, não é necessário inserir o Worksheet("nome plan").

'Se quiser enviar uma tabela dinâmica: Substitua a linha abaixo por: & RangetoHTML(.Range("Nome_Tabela_Dinâmica")) _
& RangetoHTML(Worksheets("nome_planilha").Range("A31:C38")) _
& Email.htmlbody

'Caso queira adicionar algum arquivo anexo, utilize a linha abaixo. Não se esqueça de inserir o caminho na íntegra, inclusive o tipo de arquivo.

Email.Attachments.Add ("C:\Users\caminho\Teste.png")

Email.send

End Sub
 

bottom of page