Mail in HTML formatieren
15.09.2017 15:42:43
Nordwestler
leider hat meine letzte Anfrage dazu nicht zum Erfolg geführt und ist inzwischen geschlossen. Deshalb ein neuer Versuch, weil ich noch nicht die Hoffnung aufgegeben habe, dass es geht - auch wenn ich es nicht hinkriege :-(
Dieser Teil:
.Body = Cells(10, 4) & Cells(8, 4) & Cells(9, 4) & strSignatur
soll in Arial 10 formatiert werden.
.Body zerschießt mir aber die formatierte Signatur
Wenn ich aus Body HTMLBody mache, wird die Signatur richtig formatiert dargestellt, der Text aber in Times NR 12.
Mit .HTMLBody = ' " ..." ' (ohne äußere Hochkomma, aber sonst erscheint der Text hier nicht) klappt es, dass "Cells(10,4)" als Text in Arial 10 erscheint, aber nicht der Inhalt der Zelle.
Ich hab mir schon 'nen Wolf gesucht, aber nichts gefunden, was ich passend umsetzen konnte. Vielleicht bin ich auch zu unbedarft dafür, vertraue aber auf die Kompetenz des Forums :-)
Wer kann mir bitte die nötige Erleuchtung geben, damit das letzte Problem dieser Aufgabe auch noch gelöst werden kann.
Sub Mail_in_Outlook_erzeugen_und_mit_Anhang_versenden()
Dim boSchalter As Boolean
Dim Nachricht As Object, OutApp As Object
Dim strAttachmentPfad1 As String
Dim strAttachmentPfad2 As String
Dim strAttachmentPfad3 As String
Dim strDateiname As String
Dim strSignatur As String
Set OutApp = CreateObject("Outlook.Application")
' zieht die Anlage aus der definerten Zelle aus definiertem Pfad
strDateiname = Range("g4").Value
strAttachmentPfad1 = Environ("USERPROFILE") & "\Desktop\Excel\Ergebnisse\" & strDateiname
' prüft, ob Anlagen in angegebenen Zellen vorhanden sind
If Range("D15") "" Then
strDateiname = Range("D15").Value
strAttachmentPfad2 = Environ("USERPROFILE") & "\Desktop\Excel\Anlagen\" & strDateiname
boSchalter = True
End If
If Range("D16") "" Then
strDateiname = Range("D16").Value
strAttachmentPfad3 = Environ("USERPROFILE") & "\Desktop\Excel\Anlagen\" & strDateiname
boSchalter = True
End If
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
' Outlook Signatur aktivieren
.GetInspector.Display
strSignatur = .Body
' Empfängeradressen holen aus Zeile 2, Spalte 5 (=E) usw.
.To = Cells(11, 4) & ";" & Cells(12, 4)
.Cc = Cells(13, 4) & ";" & Cells(14, 4)
' Betreff holen
.Subject = Cells(7, 4)
' Textblock: Anrede aus Zeile 2; Spalte 10 (=J), Textbaustein 1 & 2; Signatur
.Body = Cells(10, 4) & Cells(8, 4) & Cells(9, 4) & strSignatur
' Anlage 1 anhängen
.Attachments.Add strAttachmentPfad1
' Wenn oben geprüfte Zellen nicht leer sind, wird die Anlage gezogen, sonst nicht
If boSchalter Then
If Not strAttachmentPfad2 = "" Then
.Attachments.Add strAttachmentPfad2
End If
If Not strAttachmentPfad3 = "" Then
.Attachments.Add strAttachmentPfad3
End If
End If
'Mail anzeigen vor Versand
.Display
End With
'Outlook schliessen
'OutApp.Quit
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub