Outlook-Workshop - Email aus Word/Excel erstellen Teil 3
In diesem Beispiel soll der Text in der Schriftart "Arial" und der Schriftgröße "12.5" dargestellt werden. Zusätzlich sollen ausgewählte Wörter
farbig und in Schrifttyp "Kursiv" dargestellt werden. In diesem Beispiel einige Wörter rot und einige blau. Die zu färbenden Wörter müssen zuvor in jeweils einem
Array angegeben werden. Siehe hierzu die Kommentare im Beispielcode. Wir bedienen uns zum Färben der Wörter der Find-Methode.
OptionPrivateModuleOptionExplicitPublicSub Email_Erstellen_Formatiert_NU()
Dim olApp AsObjectDim wdApp AsObjectDim wdDoc AsObjectDim wdRange AsObjectDim olOldbody AsStringDim olNewBody AsStringDim vntWortBlau AsVariantDim vntWortRot AsVariantDim lngWort AsLongConst wdFindContinue = 1Rem Wörter angeben die rot gefärbt werden sollen
vntWortRot = Array("neue CD", "Hubert von Goisern", "Viel Vergnügen")
Rem Wörter angeben die blau gefärbt werden sollen
vntWortBlau = Array("vorstellen", "Schlafes Bruder", "Max")
Rem Emailtext erstellen
olNewBody = "Liebe Leserin, lieber Leser!" & "<br><br>"' Grußzeile
olNewBody = olNewBody & "Heute möchte ich Ihnen wieder eine neue CD vorstellen." & "<br><br>"' Zeile 1
olNewBody = olNewBody & "'Schlafes Bruder' von Hubert von Goisern." & " "'Zeile 2
olNewBody = olNewBody & "Die Filmmusik zum gleichnamigen Film." & "<br>"'Zeile 3
olNewBody = olNewBody & "Die Musik ganz im Stil des österreichischen Künstlers." & "<br><br>"'Zeile 4
olNewBody = olNewBody & "Viel Vergnügen beim Anhören." & "<br><br>"'Zeile 5
olNewBody = olNewBody & "Mit freundlichen Grüßen," & "<br>"' Schlußgruß
olNewBody = olNewBody & "Max Mustermann"' Name/Unterschrift Rem Outlook-Objekt erstellen Set olApp = CreateObject("Outlook.Application")
Rem Email erstellen With olApp.CreateItem(0)
.GetInspector.Display
olOldbody = .htmlBody
.To = "admin1@server.de"
.Subject = "Test"
.htmlBody = olNewBody
Rem Word-Editor-Objekt erstellen (zum Formatieren erforderlich) Set wdApp = .GetInspector
Set wdDoc = wdApp.WordEditor
Set wdRange = wdDoc.Range
wdRange.WholeStory
Rem Emailtext formatieren With wdRange
Rem Schriftart und Schriftgröße festlegen
.Font.Name = "Arial"
.Font.Size = 12.5Rem Rot färben und Schrift kursiv For lngWort = 0ToUbound(vntWortRot)
.Find.Execute FindText:=vntWortRot(lngWort), Forward:=False, Wrap:=wdFindContinue
If .Find.Found = TrueThen
.Font.Color = vbRed
.Font.Italic = TrueEndIfNext lngWort
Rem Blau färben und Schrift kursiv For lngWort = 0ToUbound(vntWortBlau)
.Find.Execute FindText:=vntWortBlau(lngWort), Forward:=False, Wrap:=wdFindContinue
If .Find.Found = TrueThen
.Font.Color = vbBlue
.Font.Italic = TrueEndIfNext lngWort
EndWithRem Emailtext um Signatur ergänzen
.htmlBody = .htmlBody & olOldbody
EndWithRem Objekte freigeben Set wdRange = NothingSet wdDoc = NothingSet wdApp = NothingSet olApp = NothingEndSub