Option Explicit
Sub Mail_HTML_erstellen_und_versenden()
'Wichtig: Zuerst im Visual Basic Editor > Extras > Verweise > Verweis auf Microsoft Outlook 1x.0 setzen
Dim objOutlookApp As Outlook.Application, objMail As Outlook.MailItem
Dim t As Variant, k As Variant

'Bildschirmaktualisierung deaktivieren
Application.ScreenUpdating = False

Set objOutlookApp = CreateObject("Outlook.Application")

Set objMail = objOutlookApp.CreateItem(olMailItem)

objMail.Subject = "Newsletter zu Updates - Nr. 1" 'Betreff anpassen
objMail.To = "Sebastian@Holzborn-Consulting.de" 'An
'objMail.CC = "Sebastian@Holzborn-Consulting.de" 'CC optional aktivieren
'objMail.BCC = "Sebastian@Holzborn-Consulting.de" 'BCC optional aktivieren
'objMail.Sensitivity = olConfidential 'vertraulich
objMail.Sensitivity = olPrivate 'privat
'objMail.Importance = olImportanceHigh 'hohe Wichtigkeit
'objMail.SentOnBehalfOfName = "Sebastian@Holzborn-Consulting.de" 'Im Namen von...
'objMail.VotingOptions = "Ich stimme zu" 'Schaltfläche, String
'objMail.FlagDueBy = "18.05.2020 12:00" 'Zur Nachverfolgung gekennzeichnet
'objMail.ExpiryTime = CDate("18.05.2020") 'Ablauf
 
objMail.HTMLBody = objMail.HTMLBody & "<FONT SIZE=2 FACE=""Arial"">Viel Spaß damit.<p>" '<p> = Absatz <br> = Umbruch
objMail.HTMLBody = objMail.HTMLBody & "Bei evtl. Rückfragen können Sie sich gerne an den Absender wenden."
objMail.HTMLBody = objMail.HTMLBody & "<p>Mit freundlichen Grüßen<br>"
objMail.HTMLBody = objMail.HTMLBody & "Max Mustermann<br>"
objMail.HTMLBody = objMail.HTMLBody & "<FONT SIZE=1 FACE=""Arial"">Tel.: 0211/123345"

'Mail anzeigen:
objMail.Display

''Variante A: Mail direkt versenden > Wenn Testlauf erfolgreich war, Anführungszeichen bei den folgenden Zeilen entfernen - es erfolgt der Versand bei Drücken von F5. Bei Bedarf stoppen mit Strg+Pause!
'SendKeys "%s", True 'senden
't = Now
'k = Now + 0.00001
'Do Until t > k
't = Now
'Loop

''Variante B: oder statt dessen in den Entwürfen speichern:
'SendKeys "^s", True  'Speichern
'SendKeys "%{F4}", True 'Schließen
't = Now
'k = Now + 0.00001
'Do Until t > k
't = Now
'Loop

Set objOutlookApp = Nothing
Set objMail = Nothing
End Sub