Como enviar cada planilha para diferentes endereços de e-mail a partir do Excel?

Se você tem uma pasta de trabalho do Excel com várias planilhas, cada uma contendo um endereço de e-mail na célula S1, pode querer enviar cada planilha como um anexo separado para seu respectivo destinatário. Essa tarefa pode ser tediosa se feita manualmente, especialmente ao lidar com um grande número de planilhas. Neste tutorial, mostraremos como usar o código VBA para enviar automaticamente cada planilha do seu arquivo do Excel como um anexo para o endereço de e-mail especificado na célula S1 de cada planilha.

Enviar cada planilha para diferentes endereços de e-mail a partir do Excel com código VBA

O seguinte código VBA permitirá que você envie cada planilha como um anexo para o destinatário correspondente listado na célula S1. Por favor, siga estes passos:

1. Pressione simultaneamente as teclas Alt+ F11 para abrir a janela do Microsoft Visual Basic for Applications.

2. Em seguida, clique em Inserir > Módulo, e copie e cole o código VBA abaixo na janela.

Código VBA: Enviar cada planilha como anexo para diferentes endereços de e-mail

Sub Mail_Every_Worksheet()
'Updateby ExtendOffice
  Dim xWs As Worksheet
  Dim xWb As Workbook
  Dim xFileExt As String
  Dim xFileFormatNum As Long
  Dim xTempFilePath As String
  Dim xFileName As String
  Dim xOlApp As Object
  Dim xMailObj As Object
  On Error Resume Next
  With Application
      .ScreenUpdating = False
      .EnableEvents = False
  End With
  xTempFilePath = Environ$("temp") & "\"
  If Val(Application.Version) < 12 Then
    xFileExt = ".xls": xFileFormatNum = -4143
  Else
    xFileExt = ".xlsm": xFileFormatNum = 52
  End If
  Set xOlApp = CreateObject("Outlook.Application")
  For Each xWs In ThisWorkbook.Worksheets
    If xWs.Range("S1").Value Like "?*@?*.?*" Then
      xWs.Copy
      Set xWb = ActiveWorkbook
      xFileName = xWs.Name & " of " _
                   & VBA.Left(ThisWorkbook.Name, VBA.InStr(ThisWorkbook.Name, ".") - 1) & " "
      Set xMailObj = xOlApp.CreateItem(0)
      xWb.Sheets.Item(1).Range("S1").Value = ""
      With xWb
        .SaveAs xTempFilePath & xFileName & xFileExt, FileFormat:=xFileFormatNum
        With xMailObj
        'specify the CC, BCC, Subject, Body below
            .To = xWs.Range("S1").Value
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there"
            .Attachments.Add xWb.FullName
            .Display
        End With
        .Close SaveChanges:=False
      End With
      Set xMailObj = Nothing
      Kill xTempFilePath & xFileName & xFileExt
    End If
  Next
  Set xOlApp = Nothing
  With Application
      .ScreenUpdating = True
      .EnableEvents = True
  End With
End Sub

3. Em seguida, pressione a tecla F5 para executar este código, e cada planilha será inserida automaticamente na janela de nova mensagem como um anexo, veja a captura de tela:

4. Finalmente, clique no botão Enviar para enviar cada e-mail um por um.

Kutools para Excel: Envie Emails Personalizados Facilmente com Um Clique!

Cansado de enviar emails para os clientes um por um? Com o recurso “Enviar Emails” do Kutools para Excel, a comunicação se torna mais rápida e profissional! Basta preparar uma planilha do Excel com nomes, endereços de email, códigos de registro e inserir marcadores de posição — o sistema irá gerar automaticamente emails personalizados e enviar centenas com apenas um clique. Chega de trabalho repetitivo!

• 💡 Marcadores de posição dinâmicos (ex.: nome, código de registro) preenchem automaticamente o conteúdo personalizado para cada destinatário, garantindo que cada email pareça exclusivamente feito sob medida.
• 📎 Anexe arquivos personalizados para entrega precisa
• 📤 Integra-se perfeitamente ao Outlook para envio seguro e confiável
• 📝 Salve e reutilize modelos de email para máxima eficiência
• 🎨 Editor WYSIWYG (o que você vê é o que você obtém) fácil de usar
• 🖋 Usa sua assinatura do Outlook — sem configuração extra, basta clicar em enviar!
• Adquira o Kutools Para Excel Agora!