VBA E-Mail Versand als Serie

Hallo in die Runde,
ich benötige Eure Unterstützung. Ich habe ein Makro mit dem ich E-Mails mit Anhang versenden kann. Nun möchte ich daraus eine Serie machen. Im Sheet "T1" befinden sich "D2 bis D240" die entsprechenden Mitgliedsnummern. Mit einem weiteren Makro frage ich nach und nach die Mitgliedsnummern ab und möchte daraus E-Mails mit dem dazugehörigen Anhang generieren. Leider bekomme ich das nicht hin.
Vielen Dank für Eure Unterstützung und Gruß, Marko


Sub E_Mail_Mgl_Abr_1_Info()
'E-Mail versenden aus Sheet Mgl_Abr_1
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim app   As Object
Dim file  As String
Dim isNew As Boolean
Dim olAPP As Object
Dim olOldBody As String
Dim signature As String
'aktueller Druckbereich A1:H61 ggf anpassen!
file = Sheets("Mgl_Abr_1").Range("L21").Text & ".pdf"
Sheets("Mgl_Abr_1").Range("A1:H61").ExportAsFixedFormat xlTypePDF, Environ("TEMP") & "\" & file
On Error Resume Next
Set app = GetObject(, "Outlook.Application")
If app Is Nothing Then
Set app = CreateObject("Outlook.Application")
isNew = True
End If
With app.CreateItem(0)
.GetInspector.Display
.To = Sheets("Mgl_Abr_1").Range("M17").Value
.Cc = Sheets("Mgl_Abr_1").Range("M18").Value
.BCC = ""
.Subject = Sheets("Mgl_Abr_1").Range("L20").Value
.htmlbody = "" _
& Sheets("Mgl_Abr_1").Range("S55") _
& "
" & Sheets("Mgl_Abr_1").Range("S56") _
& "
" & Sheets("Mgl_Abr_1").Range("S58") _
& "
" & "" & Sheets("Mgl_Abr_1").Range("S59").Value & "" _
& "
" & Sheets("Mgl_Abr_1").Range("S61") _
& "
" & "" & Sheets("Mgl_Abr_1").Range("S62").Value & "" _
& "
" & Sheets("Mgl_Abr_1").Range("S63") _
& "


	Bewerten Sie hier bitte das Excel-Portal
	
	

" & .htmlbody
.Attachments.Add Environ("TEMP") & "\" & file
.ReadReceiptRequested = True
End With
If isNew Then app.Quit
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub


Sub Info_Email_1()
'Info E-Mail an Mitglieder
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim ZAdr As String
ZAdr = Worksheets("T1").Range("D1")
For i = 2 To ZAdr
With Sheets("Mgl_Abr_1")
.Range("I9") = Sheets("T1").Cells(i, 4).Value
.Calculate
.Range("K20:K60").AutoFilter Field:=1, Criteria1:="0", visibledropdown:=False
Call E_Mail_Mgl_Abr_1_Info
End With
Next i
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

in die erste Zeile des Moduls: Dim varMailAdressen$ Sub Adressen() For i = 2 To 240 varMailAdressen = varMailAdressen & Tabelle1.Cells(i, 4) & ", " Next i varMailAdressen = Left(varMailAdressen, Len(varMailAdressen) - 2) End Sub in die Mail Prozedur: .to = varMailAdressen

Willst du die Emails personalisiert verschicken, oder eine Email an alle Adressen?
Falls personalisiert dann die Schleife so:


Option Explicit
Dim varMailAdressen$
' für personalisierten Mail Versand
Sub Adressen()
For i = 2 To 240
varMailAdressen = Tabelle1.Cells(i, 4)
Info_Email_1
Next i
End Sub

und dieses Mal kannst du ohne mit der DSGVO zu kollidieren hinter
.to varMailAdressen
die Variable schreiben. Es wird in jeden einzelnen Schleifendurchlauf jeweils die ausgelesene Mail Adresse in die Variable übergeben und das Mailprogramm ausgeführt.
Weitere Personalisierungen und/oder Anpassungen müsstest du adäquat anlegen, da keine Datei vorhanden ist und ich nicht wissen kann, was nötig ist.
Gruß Uwe

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread