Zelleninhalt in E-Mail Body
16.02.2022 18:28:19
Daniel
ich habe mich mal an einem Makro zum automatischen Versenden von Serienemails aus Excel versucht.
Ziel ist es eine EMail mit dem Inhalt der Zeile "i" Spalte A bis G an eine Mailadresse in Spalte "17" der selben Zeile zu versenden.
Zusätzlich soll geprüft werden ob in der Zeile bereits eine Mail versendet wurde, wenn ja soll diese Zeile übersprungen werden.
Hat grundsätzlich auch funktioniert, aber als ich den Body Inhalt (aus Spaten A-G) abbilden wollte erhalte ich immer einen Syntax Fehler beim kompilieren.
Falls jemand eine Idee hat woran es liegen könnte bzw. wie ich meinen Inhalt einfacher und schöner im Email Body darstellen kann gerne melden.
Bin für jeden Vorschlag dankbar. Der Bereich im Code der beim Fehler rot markiert wird habe ich unten im Code fett dargestellt.
Vielen Dank.
Daniel
'Serien Email
Sub Excel_Serial_Mail()
Dim MyOutApp As Object, MyMessage As Object
Dim i As Long
'Start der Sendeschleife an 4 Empfänger
For i = 2 To 5
'Prüfung ob Mail bereits versendet
If Cells(i, 9) = "send" Then
GoTo PruefungsEnde
End If
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Die Empfänger stehen in Spalte A ab Zeile 1
.To = Cells(i, 17) 'E-Mail Adresse
'Der Betreff in Spalte B
.Subject = "SOS Thema im Bereich " & Cells(i, 2) '"Betreffzeile"
'Der Text wird ohne Formatierung übernommen
.Body = "In Ihrem Bereich wurde folgendes SOS Thema entdeckt." & vbCrLf & _
"Bitte bearbeiten Sie das aufgezeigte Thema innerhalb der nächsten 2 Wochen." & vbCrLf & _
"Bei Rückfragen kontakieren Sie: " & Cells(i, 6) & vbCrLf & _
"SOS-Thema im Bereich:" & Cells(i, 2) & vbCrLf & _
"Thema: " & Cells(i, 1) & vbCrLf & _
"Bereich: " & Cells(i, 2) & vbCrLf & _
"Punkt SOS Checkliste: " & Cells(i, 3) & vbCrLf & _
"Bild: " & Cells(i, 5) & vbCrLf & _
"Thema aufgenommen durch: " & Cells(i, 6) & vbCrLf & _
"Thema aufgenommen am: " & Cells(i, 7) & vbCrLf & _
'Hier wird die Mail angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'.Send
End With
'Objectvariablen leeren
Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
'Sendepause einschalten
Application.Wait (Now + TimeValue("0:00:05"))
Cells(i, 9) = "send"
PruefungsEnde:
Next i
End Sub