Hur skickar man varje ark till olika e-postadresser från Excel?
Om du har en arbetsbok med flera kalkylblad och det finns en e-postadress i cell A1 på varje blad. Nu vill du skicka varje ark från arbetsboken som en bilaga till motsvarande mottagare i cell A1 individuellt. Hur kunde du lösa denna uppgift i Excel? Den här artikeln kommer jag att introducera en VBA-kod för att skicka varje ark som en bilaga till olika e-postadresser från Excel.
Skicka varje ark till olika e-postadresser från Excel med VBA-kod
Följande VBA-kod kan hjälpa dig att skicka varje ark som en bilaga till olika mottagare, vänligen gör så här:
1. Tryck Alt + F11 samtidigt för att öppna Microsoft Visual Basic för applikationer fönster.
2. Klicka sedan Insert > Modulerna, och kopiera och klistra in nedanstående VBA-kod i fönstret.
VBA-kod: Skicka varje ark som bilaga till olika e-postadresser
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 är cellen innehåller e-postadressen som du vill skicka e-postmeddelandet till. Vänligen ändra dem efter dina behov.
- Du kan ange CC, BCC, Subject, Body till ditt eget i koden;
- För att skicka e-postmeddelandet direkt utan att öppna följande nya meddelandefönster måste du ändra .Visa till .Skicka.
3. Tryck sedan på F5 för att köra den här koden, och varje ark infogas i det nya meddelandefönstret som en bilaga automatiskt, se skärmdump:
4. Slutligen behöver du bara klicka Skicka för att skicka varje e-postmeddelande ett i taget.
Bästa kontorsproduktivitetsverktyg
Uppgradera dina Excel-färdigheter med Kutools för Excel och upplev effektivitet som aldrig förr. Kutools för Excel erbjuder över 300 avancerade funktioner för att öka produktiviteten och spara tid. Klicka här för att få den funktion du behöver mest...
Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare
- Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
- Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
- Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
