Wie kann ich jedes Blatt von Excel an verschiedene E-Mail-Adressen senden?
Wenn Sie eine Arbeitsmappe mit mehreren Arbeitsblättern haben und in Zelle A1 jedes Blatts eine E-Mail-Adresse vorhanden ist. Jetzt möchten Sie jedes Blatt aus der Arbeitsmappe einzeln als Anhang an den entsprechenden Empfänger in Zelle A1 senden. Wie könnten Sie diese Aufgabe in Excel lösen? In diesem Artikel werde ich einen VBA-Code einführen, um jedes Blatt als Anhang an eine andere E-Mail-Adresse von Excel zu senden.
Senden Sie jedes Blatt aus Excel mit VBA-Code an verschiedene E-Mail-Adressen
Der folgende VBA-Code kann Ihnen helfen, jedes Blatt als Anhang an verschiedene Empfänger zu senden, gehen Sie bitte wie folgt vor:
1. Drücken Sie Alt + F11 Tasten gleichzeitig zum Öffnen der Microsoft Visual Basic für Applikationen Fenster.
2. Dann klick Insert > Modul, und kopieren Sie den folgenden VBA-Code und fügen Sie ihn in das Fenster ein.
VBA-Code: Senden Sie jedes Blatt als Anhang an verschiedene E-Mail-Adressen
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 ist die Zelle, die die E-Mail-Adresse enthält, an die Sie die E-Mail senden möchten. Bitte ändern Sie sie nach Bedarf.
- Sie können CC, BCC, Betreff und Text im Code selbst angeben;
- Um die E-Mail direkt zu senden, ohne das folgende neue Nachrichtenfenster zu öffnen, müssen Sie ändern .Anzeige zu .Senden.
3. Dann drücken F5 Taste, um diesen Code auszuführen, und jedes Blatt wird automatisch als Anhang in das neue Nachrichtenfenster eingefügt, siehe Screenshot:
4. Zum Schluss müssen Sie nur noch klicken Absenden Schaltfläche, um jede E-Mail einzeln zu senden.
Beste Office-Produktivitätstools
Verbessern Sie Ihre Excel-Kenntnisse mit Kutools for Excelund erleben Sie Effizienz wie nie zuvor. Kutools for Excel Bietet über 300 erweiterte Funktionen zur Steigerung der Produktivität und Zeitersparnis. Klicken Sie hier, um die Funktion zu erhalten, die Sie am meisten benötigen ...
Office Tab Bringt eine Tab-Oberfläche in Office und erleichtert Ihnen die Arbeit erheblich
- Aktivieren Sie das Bearbeiten und Lesen von Registerkarten in Word, Excel und PowerPoint, Publisher, Access, Visio und Project.
- Öffnen und erstellen Sie mehrere Dokumente in neuen Registerkarten desselben Fensters und nicht in neuen Fenstern.
- Steigert Ihre Produktivität um 50 % und reduziert jeden Tag Hunderte von Mausklicks für Sie!
