Enviar Email diretamente do Excel (Macro)

Oi pessoal.
Vou mostrar uma macro para enviar suas planilhas por email diretamente pelo Excel. Então você poderia me dizer: “Ah!!! Mas o Excel já me permite fazer isso através do menu Arquivo > Enviar para…“. E eu lhe digo: “Com toda razão, meu caro!”. Mas diga-me, se por um acaso, você desejasse enviar apenas uma planilha da sua pasta de trabalho, o que você faria? Copiaria essa planilha em um novo arquivo, salvaria este novo arquivo, para só depois enviá-lo. Estou certo?! Então. Esse é só um dos casos que esta macro lhe ajudaria.
Essa rotina que irei descrever pode ser adaptada para diversas situações. Você, como programador, entenderá o seu funcionamento e saberá ajustá-la para a sua necessidade, de acordo com o seu projeto. Seja para enviar automaticamente ao concluir alguma etapa do seu programa, seja para enviar planilhas seletivamente, para enviar para destinatários já cadastrados em algum banco de dados, enfim, use sua criatividade e obtenha os mais fantásticos resultados.
Primeiro, crie um módulo global para escrever a rotina de envio de emails. Vamos chamá-la de EnviarEmail.

Sub EnviarEmail()
          ActiveWorkbook.SendMail "email_do_destinatário@email.com", "Título do Email"
End Sub

O código acima dispensa maiores explicações. Ele serve para enviar todo o arquivo (pasta de trabalho) por email.
A partir dele você pode começar a se divertir, adicionando modificações que atenderão ao seu projeto, em particular. Suponha que sua necessidade seja de enviar apenas uma planilha específica dentre as inúmeras planilhas que você possui no seu arquivo. Você pode fazer assim:

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 "email_do_destinatário@email.com", "Título do Email"
 'Fecha o arquivo novo
 NovoArquivoXLS.Close
'Exclui o arquivo criado apenas para ser enviado.
Kill sExcluirAnexoTemporario
End Sub

Esta macro salvará em um novo arquivo excel somente a planilha informada e a enviará por email.
Espero que gostem.
Abraços.

Tags: No tags

153 Responses

Leave a Comment