Mail VBA - Mailadressen gruppieren
03.11.2022 20:39:25
Bernd
ich verwende u.g. Coding zum Versand von Mails aus Excel.
Nun möchte ich das Mails welche in der Spalte 9 den gleichen Inhalt haben zusammengefasst als eine Mail versendet werden und nicht einzel.
Beispiel:
Spalte 5 / Spalte 9
Mailadresse 1 / 508433
Mailadresse 2 / 508441
Mailadresse 3 / 508442
Mailadresse 4 / 508442
Mailadresse 5 / 508442
Mailadresse 6 / 508441
Mailadresse 7 / 508433
Mailadresse 1 + Mailadresse 7 soll in einer Mail versendet werden.
Mailadresse 2 + Mailadresse 6 soll in einer Mail versendet werden.
Mailadresse 3 + Mailadresse 4 + Mailadresse 5 soll in einer Mail versendet werden.
Sub Mailversand()
Dim i As Integer
Dim oApp As Object
Dim lbody As String
Dim strVorlage As String
Range("A1").Select
For i = 8 To Cells(9999, 1).End(xlUp).Row
Set oApp = CreateObject("Outlook.Application")
'Wechseln der Mailvorlage
If Cells(i, 21) = "XX" Then strVorlage = "XX.oft" Else strVorlage = "XY.oft"
Set myitem = oApp.CreateItemFromTemplate(strVorlage)
With myitem
Set .SendUsingAccount = oApp.Session.Accounts.Item("absender@xy.com")
'mail an
lto = Cells(i, 5).Value
'Betreffzeile
lsubject = Cells(i, 2).Value
lsubject = lsubject + " - " & Cells(i, 14).Value
lsubject = lsubject + " - " & Cells(i, 15).Value
'Bodytext
lbody = myitem.HTMLBody
lbody = Replace(lbody, "#2#", Cells(i, 2).Value)
lbody = Replace(lbody, "#14#", Cells(i, 14).Value)
lbody = Replace(lbody, "#15#", Cells(i, 15).Value)
lbody = Replace(lbody, "#17#", Cells(i, 17).Value)
lbody = Replace(lbody, "#18#", Cells(i, 18).Value)
lbody = Replace(lbody, "#19#", Cells(i, 19).Value)
lbody = Replace(lbody, "#20#", Replace(Cells(i, 20).Value, Chr(10), "
"))
myitem.To = lto
myitem.cc = lcc
myitem.bcc = lbcc
myitem.Subject = lsubject
myitem.HTMLBody = lbody
myitem.Display
myitem.send
End With
Next i
End Sub
Bernd