Usuário com melhor resposta
Envio de e-mail pelo excel colocando um texto no corpo do e-mail

Pergunta
-
Respostas
-
Com este método não é possível editar o corpo da mensagem.
(https://msdn.microsoft.com/en-us/library/office/ff821053.aspx)
--
Sugiro que adapte as funções das referências abaixo, conforme sua necessidade.
http://excelsemlimites.com/2012/03/21/vba-enviar-email-do-outlook-usando-o-excel/ (outlook)
http://www.cpearson.com/excel/Email.aspx (cdo)
- Sugerido como Resposta André Santo terça-feira, 21 de julho de 2015 17:00
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator quinta-feira, 5 de novembro de 2015 15:38
-
Consegui resolver montando desta forma.
Sub EnviarEmailPlanilhaEspecifica()
Dim NovoArquivoXLS As Workbook
Dim sPlanAEnviar As String
Dim sExcluirAnexoTemporario As String
Dim objOlAppApp As Outlook.Application
Dim objOlAppMsg As Outlook.MailItem
Dim objOlAppRecip As Outlook.Recipient
Dim Destinatario As String
Dim x As String
'Define a planilha que será enviada por email. Ex.: Plan1, Balancete, Lista De Nomes, etc
sPlanAEnviar = "sheet"
'Cria um novo arquivo excel
Set NovoArquivoXLS = Application.Workbooks.Add
'Copia a planilha para o novo arquivo criado
ThisWorkbook.Sheets(sPlanAEnviar).Copy Before:=NovoArquivoXLS.Sheets(1)
'Determina o x
x = Range("c5").Value
'Salva o arquivo
NovoArquivoXLS.SaveAs ThisWorkbook.Path & "\" & sPlanAEnviar & " " & x & ".xls"
sExcluirAnexoTemporario = NovoArquivoXLS.FullName
'Aqui começa o envio do email:
'Criar objeto do outlook
Set objOlAppApp = CreateObject("Outlook.Application")
Set objOlAppMsg = objOlAppApp.CreateItem(olMailItem)
'Determina o destinatário
Destinatario = "xxxxxxxxxxx"
With objOlAppMsg
'Email do destinatário
Set objOlAppRecip = .Recipients.Add(Destinatario)
objOlAppRecip.Type = olTo
'Anexa o arquivo
.Attachments.Add (sExcluirAnexoTemporario)
'Grau de importância do email
.Importance = olImportanceNormal
'Cabeçalho do email
.Subject = ("Assunto")
'Texto do email
.Body = "texto"
'Enviar email
.Send
'se quiser ver o email antes de enviar automaticamente .Display
End With
'MsgBox "E-mail enviado com sucesso!", vbOKOnly, "Aviso"
'Fecha o arquivo novo
NovoArquivoXLS.Close
'Exclui o arquivo criado apenas para ser enviado.
Kill sExcluirAnexoTemporario
'Sheets("Plan1").cell.ClearContents
End SubObrigado!
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator quinta-feira, 5 de novembro de 2015 15:38
Todas as Respostas
-
-
André, segue o programa utilizado.
Sub EnviarEmailnome()
Dim NovoArquivoXLS As Workbook
Dim sPlanAEnviar As String
Dim sExcluirAnexoTemporario As String
'Define a planilha que será enviada por email. Ex.: Plan1, Balancete, Lista De Nomes, etc
sPlanAEnviar = "nome"
'Cria um novo arquivo excel
Set NovoArquivoXLS = Application.Workbooks.Add
'Copia a planilha para o novo arquivo criado
ThisWorkbook.Sheets(sPlanAEnviar).Copy Before:=NovoArquivoXLS.Sheets(1)
'Salva o arquivo
NovoArquivoXLS.SaveAs ThisWorkbook.Path & "\" & sPlanAEnviar & ".xls"
sExcluirAnexoTemporario = NovoArquivoXLS.FullName
'Envia o email
NovoArquivoXLS.SendMail "endereço", "assunto"
'Fecha o arquivo novo
NovoArquivoXLS.Close
'Exclui o arquivo criado apenas para ser enviado.
Kill sExcluirAnexoTemporario
End Sub -
Com este método não é possível editar o corpo da mensagem.
(https://msdn.microsoft.com/en-us/library/office/ff821053.aspx)
--
Sugiro que adapte as funções das referências abaixo, conforme sua necessidade.
http://excelsemlimites.com/2012/03/21/vba-enviar-email-do-outlook-usando-o-excel/ (outlook)
http://www.cpearson.com/excel/Email.aspx (cdo)
- Sugerido como Resposta André Santo terça-feira, 21 de julho de 2015 17:00
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator quinta-feira, 5 de novembro de 2015 15:38
-
Consegui resolver montando desta forma.
Sub EnviarEmailPlanilhaEspecifica()
Dim NovoArquivoXLS As Workbook
Dim sPlanAEnviar As String
Dim sExcluirAnexoTemporario As String
Dim objOlAppApp As Outlook.Application
Dim objOlAppMsg As Outlook.MailItem
Dim objOlAppRecip As Outlook.Recipient
Dim Destinatario As String
Dim x As String
'Define a planilha que será enviada por email. Ex.: Plan1, Balancete, Lista De Nomes, etc
sPlanAEnviar = "sheet"
'Cria um novo arquivo excel
Set NovoArquivoXLS = Application.Workbooks.Add
'Copia a planilha para o novo arquivo criado
ThisWorkbook.Sheets(sPlanAEnviar).Copy Before:=NovoArquivoXLS.Sheets(1)
'Determina o x
x = Range("c5").Value
'Salva o arquivo
NovoArquivoXLS.SaveAs ThisWorkbook.Path & "\" & sPlanAEnviar & " " & x & ".xls"
sExcluirAnexoTemporario = NovoArquivoXLS.FullName
'Aqui começa o envio do email:
'Criar objeto do outlook
Set objOlAppApp = CreateObject("Outlook.Application")
Set objOlAppMsg = objOlAppApp.CreateItem(olMailItem)
'Determina o destinatário
Destinatario = "xxxxxxxxxxx"
With objOlAppMsg
'Email do destinatário
Set objOlAppRecip = .Recipients.Add(Destinatario)
objOlAppRecip.Type = olTo
'Anexa o arquivo
.Attachments.Add (sExcluirAnexoTemporario)
'Grau de importância do email
.Importance = olImportanceNormal
'Cabeçalho do email
.Subject = ("Assunto")
'Texto do email
.Body = "texto"
'Enviar email
.Send
'se quiser ver o email antes de enviar automaticamente .Display
End With
'MsgBox "E-mail enviado com sucesso!", vbOKOnly, "Aviso"
'Fecha o arquivo novo
NovoArquivoXLS.Close
'Exclui o arquivo criado apenas para ser enviado.
Kill sExcluirAnexoTemporario
'Sheets("Plan1").cell.ClearContents
End SubObrigado!
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator quinta-feira, 5 de novembro de 2015 15:38
-