Como enviar cada planilha para diferentes endereços de e-mail do Excel?
Se você tiver uma pasta de trabalho com várias planilhas e houver um endereço de email na célula A1 de cada planilha. Agora, você deseja enviar cada planilha da pasta de trabalho como um anexo para o destinatário correspondente na célula A1 individualmente. Como você poderia resolver essa tarefa no Excel? Neste artigo, apresentarei um código VBA para enviar cada planilha como anexo para um endereço de e-mail diferente do Excel.
Envie cada planilha para diferentes endereços de e-mail do Excel com código VBA
O código VBA a seguir pode ajudá-lo a enviar cada planilha como um anexo para diferentes destinatários, faça o seguinte:
1. pressione Alt + F11 simultaneamente para abrir o Microsoft Visual Basic para Aplicações janela.
2. Então clique inserção > Módulo, e copie e cole o código VBA abaixo na janela.
Código VBA: envie 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
- S1 é a célula que contém o endereço de e-mail para o qual você deseja enviar o e-mail. Por favor, altere-os para sua necessidade.
- Você pode especificar o CC, BCC, Assunto, Corpo para o seu próprio código;
- Para enviar o e-mail diretamente sem abrir a janela de nova mensagem a seguir, você precisa alterar .Exibição para .Mandar.
3. Então aperte F5 key para executar este código, e cada planilha é inserida na nova janela de mensagem como um anexo automaticamente, veja a captura de tela:
4. Por fim, basta clicar ENVIAR botão para enviar cada e-mail um por um.
Melhores ferramentas de produtividade de escritório
Aprimore suas habilidades de Excel com o Kutools para Excel e experimente uma eficiência como nunca antes. Kutools para Excel oferece mais de 300 recursos avançados para aumentar a produtividade e economizar tempo. Clique aqui para obter o recurso que você mais precisa...
Office Tab traz interface com guias para o Office e torna seu trabalho muito mais fácil
- Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
- Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
- Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
