E-Mail aus Excel Textfile generieren mit Hyperlinks und Bildern
05.02.2020 21:17:38
Dan
nach tagelanger Suche verzweifle ich leider langsam. Ich hab einen Datensatz mit einigen 100 E-Mail-Adressen in Excel. Ich hab mich nun an das Thema VBA Excel herangewagt und relativ schnell einen Code zusammengefunden, welcher nun auch funktioniert. Dieser generiert mir aus meinen Datensätzen E-Mails aus einem Textfeld und schickt sie ab. Soweit so gut, aber ich möchte in diesem Textfeld nicht nur die Anrede anhand meines Datensatzes variieren (das klappt), sondern auch 6 Hyperlinks im Text hinterlegen sowie 2 Bilder in den E-Mail Text jeweils oben und unten einbinden sowie den E-Mail Text zentrieren mit Farbunterlegung und Einzug links und rechts, sodass ein schönes optisches Bild abgibt.
Ich kann zwar Bilder anhängen, aber das war es dann auch schon. Alle Textschnipsel was ich irgendwo finden konnte, sind entweder nicht mehr unterstützt bei dem 2016 Paket oder aber ich muss irgendwelche Verweise / Redemption aktivieren oder so ähnlich, woraus ich auch nicht schlau werde. Hab das mit den Verweisen gefunden und alles mögliche, was Outlook heißt auch schon mal aktiviert gehabt, etc. Ging auch nicht. Es kann ja denke ich eigentlich gar nicht so schwer sein, werde wohl nicht der erste Mensch sein, der nenn automatisch generierten Newsletter mit Bild, Hyperlink und Anrede möchte. Aber ich bin wohl einfach zu blöd dafür
Könnte sich vllt. jemand meinen Code ansehen und mir weiterhelfen. Ich verzweifle noch :(
Option Explicit
Sub NewsletterDeutsch()
Send_Email
End Sub
Private Sub Send_Email()
'Email Titel'
Dim sTitle As String
sTitle = "Willkommen"
'HMTL holen'
Dim sTemplate As String
sTemplate = Sheets("NewsletterDeutsch").Shapes(1).TextFrame2.TextRange.Text
'Outlook Versand'
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
'Einstellungen Mail'
Dim objEmail As Object
Dim sEmail_Address As String
Dim Anrede As String
Dim Zeile As Integer
For Zeile = 2 To 10000
If Cells(Zeile, 9) = "Deutsch" Then
sEmail_Address = Cells(Zeile, 7)
Anrede = Cells(Zeile, 3)
Dim sHTML As String
sHTML = Replace(sTemplate, "[@Name]", Anrede)
'Email schicken'
Set objEmail = objOutlook.CreateItem(0)
objEmail.To = sEmail_Address
objEmail.Subject = sTitle
objEmail.Body = sHTML
objEmail.Attachments.Add ("C:\Users\unbekannt\Desktop\Bild.jpg")
objEmail.display False
objEmail.Send
End If
Next
'Schließen'
Set objEmail = Nothing
Set objOutlook = Nothing
MsgBox "Erfolgreich", vbInformation, "Fertig"
End Sub
Liebe Grüße
Dani