VBA Enviar e-mails do Excel para o Outlook

Este tutorial mostrará como enviar e-mails do Excel através o Outlook usando o VBA.

Enviando a Pasta de Trabalho Ativa

Function EnviarActiveWorkbook(strTo As String, strSubject As String, Optional strCC As String, Optional strBody As String) As Boolean
   On Error Resume Next
   Dim appOutlook As Object
   Dim mItem As Object
'Criar uma nova instância Outlook
   Set appOutlook = CreateObject("Outlook.Application")
   Set mItem = appOutlook.CreateItem(0)
   With mItem 
     .To = strTo
     .CC = ""
     .Subject = strSubject
     .Body = strBody
     .Attachments.Add ActiveWorkbook.FullName
'usar send para enviar imediatamente ou display para mostrar na tela
    .Display 'ou .Send
   End With
'Limpar os objetos
  Set mItem = Nothing
  Set appOutlook = Nothing
End Function

A função acima pode ser chamada usando o procedimento abaixo

Sub EnviarEmail()
   Dim strTo As String
   Dim strSubject As String
   Dim strBody As String
'Preencher Variaveis
   strTo = "jon.smith@gmail.com"
   strSubject = "Veja o arquivo financeiro em anexo"
   strBody = "algum texto vai aqui para o corpo do e-mail"
'chamar a função para enviar o e-mail
   If EnviarActiveWorkbook(strTo, strSubject, , strBody) = true then
      Msgbox "Email criado com sucesso"
   Else
      Msgbox "Erro na criação do email!"
   End if
End Sub

Uso de Early Binding para Fazer Referência à Biblioteca de Objetos do Outlook

O código acima usa Late Binding para fazer referência ao objeto do Outlook. Se preferir, você pode adicionar uma referência ao Excel VBA e declarar o aplicativo do Outlook e o Item de Correio do Outlook usando a Vinculação Antecipada. A vinculação antecipada torna o código mais rápido, mas limita você, pois o usuário precisaria ter a mesma versão do Microsoft Office em seu PC.

Clique no menu Ferramentas e em Referências para exibir a caixa de diálogo de referência.

Adicione uma referência à biblioteca de objetos do Microsoft Outlook para a versão do Office que você está usando.

Em seguida, você pode alterar seu código para usar essas referências diretamente.

Uma grande vantagem da vinculação antecipada são as listas suspensas que mostram os objetos que estão disponíveis para uso!

Envio de uma Única Planilha a Partir da Pasta de Trabalho Ativa

Para enviar uma única planilha, primeiro você precisa criar uma nova pasta de trabalho a partir da pasta de trabalho existente com apenas essa planilha e, em seguida, enviar essa planilha.

Function EnviarPlanilhaAtiva(strTo As String, strSubject As String, Optional strCC As String, Optional strBody As String) As Boolean
   On Error GoTo eh
'declarar variáveis para conter os objetos necessários
   Dim wbDestination As Workbook
   Dim strDestName As String
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim OutApp As Object
   Dim OutMail As Object
   Dim strTempName As String
   Dim strTempPath As String
'Primeiro, crie a pasta de trabalho de destino
   Set wbDestination = Workbooks.Add
   strDestName = wbDestination.Name
'definir a pasta de trabalho e a planilha de origem
   Set wbSource = ActiveWorkbook
   Set wsSource = wbSource.ActiveSheet
'copiar a planilha ativa para a nova pasta de trabalho
   wsSource.Copy After:=Workbooks(strDestName).Sheets(1)
'salvar com um nome temporário
   strTempPath = Environ$("temp") & ""
   strTempName = "Lista obtida de " & wbSource.Name & ".xlsx"
   With wbDestination
      .SaveAs strTempPath & strTempName
'agora envie por e-mail a pasta de trabalho de destino
      Set OutApp = CreateObject("Outlook.Application")
      Set OutMail = OutApp.CreateItem(0)
      With OutMail
         .To = strTo
         .Subject = strSubject
         .Body = strBody
         .Attachments.Add wbDestination.FullName
'use send para enviar imediatamente ou display para mostrar na tela
         .Display 'ou .Send
      End With
      .Close False
  End With
'excluir a pasta de trabalho temporária que você anexou ao seu e-mail
   Kill strTempPath & strTempName
'limpar os objetos para liberar a memória
   Set wbDestination = Nothing
   Set wbSource = Nothing
   Set wsSource = Nothing
   Set OutMail = Nothing
   Set OutApp = Nothing
Exit Function
eh:
   MsgBox Err.Description
End Function

e para executar essa função, podemos criar o seguinte procedimento

Sub EnviarPlanilhaEmail()
   Dim strTo As String
   Dim strSubject As String
   Dim strBody As String
   strTo = "jon.smith@gmail.com"
   strSubject = "Veja o arquivo financeiro em anexo"
   strBody = "algum texto vai aqui para o corpo do e-mail"
   If EnviarPlanilhaAtiva(strTo, strSubject, , strBody) = True Then
      MsgBox "Email criado com sucesso"
   Else
      MsgBox "Erro na criação do email!"
   End If
End Sub