Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Envio de Email Auto...
 
Notifications
Clear all

Envio de Email Automático

 
2024 - VBA & Macros
Post Recente por edneyol 8 anos atrás
4 Posts
3 Usuários
0 Reactions
963 Visualizações
RSS
 edneyol
(@edneyol)
Posts: 8
Active Member
Topic starter
 

Boa tarde a todos,

Estou estudando VBA no excel e estou tentando enviar uma planilha automaticamente por email, consegui enviar com os códigos abaixo, porém precisa fazer algumas modificações que não consegui.

1° - preciso enviar para mais de um endereço de email e não consegui colocar mais de um
2° - previso escrever um texto no corpo do email e não consegui

Alguém consegui me ajudar?? ficarei muito agradecido, abraços!!!! Abaixo os códigos que usei....

Sub EnviarEmailPlanilhaEspecifica()

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 = "Plan2"

 '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 "edneyoliveira@hotmail.com", "Críticos"
 
 
 'Fecha o arquivo novo
 NovoArquivoXLS.Close

 
'Exclui o arquivo criado apenas para ser enviado.
Kill sExcluirAnexoTemporario

 
End Sub
 
Postado : 15/07/2016 2:01 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Legal ...
Vc escreveu quase tudo, so faltou o principal.
Mas tudo bem.

 
Postado : 15/07/2016 3:17 pm
 engeel2014
(@engeel2014)
Posts: 207
Reputable Member
 

Boa noite amigo, use o código abaixo:

Sub EnviarEmailPlanilhando()

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 = "Plan2"

'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

Dim MyOlapp As Object, MeuItem As Object
Set MyOlapp = CreateObject("Outlook.Application")
Set MeuItem = MyOlapp.CreateItem(olMailItem)
With MeuItem
    .to = ("email1@msn.com;email2@msn.com;email4@msn.com;email4@msn.com")
    .Subject = "Título do e-mail"
    .Body = "Bom dia Sr.Fulano da Silva" & vbCrLf & _
           "Anexo planilha Relatório com os dados solicitados" & vbCrLf & _
           "Janeiro/2016 " & vbCrLf & _
           "Saudações "
    .Attachments.Add ThisWorkbook.Path & "" & sPlanAEnviar & ".xls"
    .Display
End With

'Fecha o arquivo novo
NovoArquivoXLS.Close

'Exclui o arquivo criado apenas para ser enviado.
Kill sExcluirAnexoTemporario

End Sub

Este código foi adaptado de :
http://www.microsoftexcel.com.br/index.php/excel-dicas-microsoft-excel-vba/89-excel-vba-envia-email/1344-excel-vba-planilha-email-envia-anexo-e-corpo.html

 
Postado : 15/07/2016 3:56 pm
 edneyol
(@edneyol)
Posts: 8
Active Member
Topic starter
 

bom dia,

Perfeito, muito obrigado pela ajuda!

 
Postado : 18/07/2016 7:46 am
Forum Jump:
  Tópico Anterior
Próximo Tópico