Thunderbird-Workshop - Teil 2 - Emailtext formatieren

Dieser Teil baut auf "Thunderbird-Workshop - Grundlagen" auf.

In diesem Teil wollen wir Zellinhalte in den Emailtext übernehmen. Hierbei wird die Formatierung der Zellen übernommen. Es wird die in Zelle E1 eingetragene Datei angehängt.

Zellinhalt:

Arbeitsblatt mit dem Namen 'E-Mail'
	A	B	C	D	E
1	männlich	x	max@mustermann.de		C:\Users\Rene\Desktop\Erklaerblatt_Abrechnungsbescheinigung.pdf
2
3	Max Mustermann

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

Code:

Public Sub SendHtmlMailWithThunderbird()

    
    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 = Worksheets("E-Mail").Range("A3").Value

        Rem Auslesen der Schriftgestaltung
        strFntClr = FarbeInHtml(Worksheets("E-Mail").Range("A3").Font.Color)
        strFntNme = Worksheets("E-Mail").Range("A3").Font.Name
        strFntSiz = Worksheets("E-Mail").Range("A3").Font.Size
        strFntWht = IIf(Worksheets("E-Mail").Range("A3").Font.Bold, "bold", "standard")
        strFntStl = IIf(Worksheets("E-Mail").Range("A3").Font.Italic, "italic", "standard")
        
        Rem Inhalt der Email zusammenstellen. Aktive Datei wird angehängt
        With NeueThunderbirdEMail
            .EmailFormat = 1
            .SendenVonKonto = 2
            .Empfaenger = Worksheets("E-Mail").Range("C1").Value
            .Betreff = "Ihre Unterlagen"
            .EMailText = 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"

            .Anhang = Worksheets("E-Mail").Range("E1").Value
        End With

Rem Email erstellen
Call CreateThunderbirdEmailObject

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