Outlook-Workshop - Email aus Word/Excel erstellen Teil 4

Hier werden wir lernen wie man die Schriftgestaltung einer Excel-Zelle in den Emailtext übernimmt. Im Beispiel wird nur der Name (Anrede) übernommen, der Rest des Textes wird in Standardeinstellung dargestellt. Damit die Textfarbe übernommen werden kann wird sie zuvor mit der Funktion "FarbeInHtml" in HTML-Farbangaben umgewandelt.


Zellinhalt:

Arbeitsblatt mit dem Namen 'E-Mail'
	A	B	C
1	männlich	X	max@mustermann.de
2
3	Max Mustermann

Zelle	Schriftart	Schriftgröße	Extras/Unterstrichen	Inhalt
A3	Arial Narrow [Fett, Kursiv]	14	Einfach	Max Mustermann

Code:

Option Explicit

Sub Email_versenden()
    Dim olApp      As Object
    Dim strAnrede  As String
    Dim strName    As String
    Dim strFntClr  As String
    Dim strFntNme  As String
    Dim strFntWht  As String
    Dim strFntSiz  As String
    Dim strFntStl  As String
    Dim strFntUdl  As String
    
        Rem Festlegung der Anrede 
        If Worksheets("E-Mail").Range("A1").Value = "männlich" Then
               strAnrede = "Sehr geehrter Herr "
        ElseIf Worksheets("E-Mail").Range("A1").Value = "weiblich" Then
               strAnrede = "Sehr geehrte Frau "
        Else
               Exit Sub
        End If
        strName = Range("A3").Value

        Rem Auslesen der Schriftgestaltung 
        strFntClr = FarbeInHtml(Range("A3").Font.Color)
        strFntNme = Range("A3").Font.Name
        strFntSiz = Range("A3").Font.Size
        strFntWht = IIf(Range("A3").Font.Bold, "bold", "standard")
        strFntStl = IIf(Range("A3").Font.Italic, "italic", "standard")

               
        Rem Erstellen der Email 
        Set olApp = CreateObject("Outlook.Application")
            With olApp.CreateItem(0)
                .To = Worksheets("E-Mail").Range("C1").Value
                .Subject = "Ihre Anforderung"
                .htmlBody = strAnrede & "<span style='color:" & strFntClr & "; " & _
                            "font-family:" & strFntNme & "; font-size:" & strFntSiz & _
                            "pt; font-weight:" & strFntWht & "; font-style:" & strFntStl & _
                            ";'>" & strName & "</span>,<br><br>" & _
                            "anbei gewünschte Unterlagen.<br><br>" & _
                            "Mit freundlichen Grüßen,<br>Emil Bergbauer"
                                
                    .Display
                End With
            

End Sub

Public Function FarbeInHtml(ByVal lngRGB As Long) As String
FarbeInHtml = Right$("000000" & Hex$(lngRGB), 6)
FarbeInHtml = "#" & Right$(FarbeInHtml, 2) & Mid$(FarbeInHtml, 3, 2) & Left$(FarbeInHtml, 2)
End Function