Hogyan küldhetek el minden egyes lapot különböző e-mail címekre az Excelből?
Ha van egy munkafüzete több munkalappal, és minden lap A1 cellájában van egy e-mail cím. Most a munkafüzet minden egyes lapját mellékletként szeretné elküldeni az A1 cellában lévő megfelelő címzettnek. Hogyan tudnád megoldani ezt a feladatot Excelben? Ebben a cikkben bemutatok egy VBA-kódot, amellyel minden egyes lapot csatolmányként elküldhetek az Excel különböző e-mail-címére.
Küldje el az egyes lapot különböző e-mail címekre az Excelből VBA-kóddal
A következő VBA-kód segíthet az egyes lapok mellékletként történő elküldésében különböző címzetteknek, kérjük, tegye a következőket:
1. nyomja meg Alt + F11 gombok egyszerre a Microsoft Visual Basic for Applications ablak.
2. Ezután kattints a gombra betétlap > Modulok, majd másolja és illessze be az alábbi VBA-kódot az ablakba.
VBA-kód: Küldje el az egyes lapot mellékletként különböző e-mail címekre
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 az a cella, amely azt az e-mail címet tartalmazza, amelyre az e-mailt el szeretné küldeni. Kérjük, módosítsa őket az Ön igényei szerint.
- A kódban megadhatja a CC, BCC, Subject, Body a sajátját;
- Ha közvetlenül szeretné elküldeni az e-mailt a következő új üzenetablak megnyitása nélkül, módosítania kell .Kijelző nak nek .Küld.
3. Ezután nyomja meg a gombot F5 gombot a kód futtatásához, és minden egyes lap automatikusan csatolmányként bekerül az új üzenetablakba, lásd a képernyőképet:
4. Végül csak kattintani kell Küldés gombot az egyes e-mailek elküldéséhez.
A legjobb irodai hatékonyságnövelő eszközök
Töltsd fel Excel-készségeidet a Kutools for Excel segítségével, és tapasztald meg a még soha nem látott hatékonyságot. A Kutools for Excel több mint 300 speciális funkciót kínál a termelékenység fokozásához és az időmegtakarításhoz. Kattintson ide, hogy megszerezze a leginkább szükséges funkciót...
Az Office lap füles felületet hoz az Office-ba, és sokkal könnyebbé teszi a munkáját
- Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
- Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
- 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
