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.

Option Private Module
Option Explicit

Public Sub Email_Erstellen_Formatiert_NU()

Dim olApp        As Object
Dim wdApp        As Object
Dim wdDoc        As Object
Dim wdRange      As Object
Dim olOldbody    As String
Dim olNewBody    As String
Dim vntWortBlau  As Variant
Dim vntWortRot   As Variant
Dim lngWort      As Long

Const wdFindContinue = 1

Rem 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.5
                 
                 Rem Rot färben und Schrift kursiv 
                 For lngWort = 0 To Ubound(vntWortRot)
                     .Find.Execute FindText:=vntWortRot(lngWort), Forward:=False, Wrap:=wdFindContinue
                           If .Find.Found = True Then
                              .Font.Color = vbRed
                              .Font.Italic = True
                           End If
                 Next lngWort
                 
                 Rem Blau färben und Schrift kursiv 
                 For lngWort = 0 To Ubound(vntWortBlau)
                     .Find.Execute FindText:=vntWortBlau(lngWort), Forward:=False, Wrap:=wdFindContinue
                           If .Find.Found = True Then
                              .Font.Color = vbBlue
                              .Font.Italic = True
                           End If
                 Next lngWort
                 
            End With
            
              Rem Emailtext um Signatur ergänzen 
              .htmlBody = .htmlBody & olOldbody
    End With


Rem Objekte freigeben 
Set wdRange = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
Set olApp = Nothing

End Sub