Hvordan sender man hvert ark til forskellige e-mailadresser fra Excel?
Hvis du har en projektmappe med flere arbejdsark, og der er en e-mailadresse i celle A1 på hvert ark. Nu vil du sende hvert ark fra projektmappen som en vedhæftet fil til den tilsvarende modtager i celle A1 individuelt. Hvordan kunne du løse denne opgave i Excel? I denne artikel vil jeg introducere en VBA-kode til at sende hvert ark som en vedhæftet fil til en anden e-mailadresse fra Excel.
Send hvert ark til forskellige e-mailadresser fra Excel med VBA-kode
Følgende VBA-kode kan hjælpe dig med at sende hvert ark som en vedhæftet fil til forskellige modtagere, gør venligst følgende:
1. Trykke Alt + F11 taster samtidigt for at åbne Microsoft Visual Basic til applikationer vindue.
2. Klik derefter på indsatte > Moduler, og kopier og indsæt nedenstående VBA-kode i vinduet.
VBA-kode: Send hvert ark som vedhæftet fil til forskellige e-mailadresser
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 er cellen indeholder den e-mailadresse, som du vil sende e-mailen til. Venligst ændre dem til dit behov.
- Du kan angive CC, BCC, Emne, Body til din egen i koden;
- For at sende e-mailen direkte uden at åbne det følgende nye beskedvindue, skal du ændre .Skærm til .Sende.
3. Tryk derefter på F5 tasten for at køre denne kode, og hvert ark indsættes automatisk i det nye meddelelsesvindue som en vedhæftet fil, se skærmbillede:
4. Til sidst skal du bare klikke Send knappen for at sende hver e-mail en efter en.
Bedste kontorproduktivitetsværktøjer
Overlad dine Excel-færdigheder med Kutools til Excel, og oplev effektivitet som aldrig før. Kutools til Excel tilbyder over 300 avancerede funktioner for at øge produktiviteten og spare tid. Klik her for at få den funktion, du har mest brug for...
Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere
- Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
- Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
- Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
