Inquiridor
Macro para Gerar Relatório PDF e automaticamente enviar por e-mail

Pergunta
-
Todas as Respostas
-
-
-
BárbaraBettanin o código exporta a planilha (aba) ativa para o formato pdf na área de trabalho (desktop), em seguida envia e-mail pelo Outlook anexando o pdf
Este exemplo é genérico, caso não consiga adaptar a seu cenário, disponibilize seu modelo para que possamos ajustar.
Sub EnviarEmailPeloExcelAnexoPDF()
Dim sPara As String
Dim sMsg As String
Dim sAssunt As String
Dim PdfCaminho As String
Dim PdfNome As String
' ALTERE O CAMINHO Q SERA SALVO O PDF SE NECCESS.
PdfCaminho = VBA.Environ("USERPROFILE") & "\Desktop\"
' ALTERE O NOME DO PDF DE ACORDO COM A NECESS.
PdfNome = "Relatório_" & VBA.Format(VBA.Now, "yyyy-mm-dd") & ".pdf"
ThisWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
PdfCaminho & PdfNome, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
sPara = "e-mail_do_destinatario@gmail.com"
If Not sPara = "" Then
sAssunt = "Assunto de Envio de Relatório em Anexo"
sMsg = "Mensagem teste de envio de e-mail com anexo"
Envia_Emails sPara, sMsg, sAssunt, PdfCaminho & PdfNome
End If
End Sub
Sub Envia_Emails(sPara As String, sMsg As String, sAssunt As String, PdfAnexo As String)
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = sPara
.CC = ""
.BCC = ""
.Subject = sAssunt
.Body = sMsg
.Attachments.Add PdfAnexo
.Display ' para envia o email diretamente defina o código .Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub* Altere o endereço de e-mail do destinatário
- Editado Ricardo Vba quinta-feira, 29 de março de 2018 15:38
- Sugerido como Resposta isadorazuim sexta-feira, 13 de novembro de 2020 19:23
-
-
Bárbara, não ficou claro pra mim se deseja definir algum conteúdo no assunto e no corpo do e-mail.
Defini a célula F10 como o destinatário do e-mail e o arquivo pdf será salvo na pasta Desktop do usuário e enviado como anexo.
Segue o link do arquivo.
https://1drv.ms/x/s!ArZtNnQlPyfnhjM0y8MC2fFtNKIG
Click em propor como resposta se foi util a voce. ricardodm@outlook.com.br
-
-
De nada. Acrescentei a copia (CC), para o seu e-mail e o assunto "Romaneio de Pedido" e no corpo do e-mail (mensagem) coloquei como "Em anexo Romaneio de Pedido" se quiser alterar avise.
Segue o link.
https://1drv.ms/x/s!ArZtNnQlPyfnhjeV83iKpsgfEYXn
Click em propor como resposta se foi util a voce. ricardodm@outlook.com.br
- Editado Ricardo Vba segunda-feira, 2 de abril de 2018 21:30
-
-
Acredito que o motivo do erro seja porque alguma referencia conforme imagem 2 abaixo, não esteja marcada.
Para verificar, aperte as teclas Alt+ F11, vá na aba Ferramentas e selecione Referencias.. e marque-as, de acordo com a versão do seu office.
VB for Applications
Microsoft Excel XX.0 Object Library
OLE Automation
Microsoft Office XX.0 Object Library
Microsoft Forms 2.0 Object LibraryImagem1
imagem2:
Click em propor como resposta se foi util a voce. ricardodm@outlook.com.br
- Editado Ricardo Vba quarta-feira, 4 de abril de 2018 00:04
-
-
Experiente marcar a referencia " Microsoft Outlook XX.0 Object Library " onde XX é a versão do office., procure de acordo com a sua versão.
E utilize o código abaixo de envio do e-mail com algumas alterações.
Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = sPara
.CC = sCC
.BCC = ""
.Subject = sAssunt
.Body = sMsg
.Attachments.Add PdfAnexo
.Display ' para envia o email diretamente defina o código .Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub- Editado Ricardo Vba quarta-feira, 4 de abril de 2018 18:48
-
-
Boa tarde Ricardo
Preciso uma Macro para salvar em PDF e enviar por email - webmail, devendo salvar nome do arquivo conforme célula AN7 e endereço de email destinatário conforme célula AN8.
Se puder auxiliar agradeço.
Abaixo planilha.
https://drive.google.com/file/d/0Bz7ao8oL6eWVb3NSWVVyWkpwNVdYS2U1NGROOG11eEZuTGdJ/view?usp=sharing
-
-
-
-
-
-