Signatur einfügen bei Outlook

Karin · 12. November 2019 um 14:34

Hallo liebe Experten,

Reinhard hat mir einmal ganz wunderbar bei diesem VBA-Code geholfen, der automatisch eine Word-Datei (Office 2007) als PDF-Anlage in Outlook einbindet und den Text im Outlook-Body einfügt.

Leider wird aber keine Outlook-Signatur unter dem Text eingefügt, obwohl in Outlook eingestellt ist, dass bei einer neuen Mail die Standard-Signatur verwendet werden soll.

Welcher VBA-Code müsste dafür noch eingefügt werden? Ich hab schon ein bisschen mit .getinspector etc. probiert, aber leider keinen Erfolg gehabt.

Vielen Dank für Eure Hilfe!!!

Karin

Option Explicit
Sub Reservierungsbestätigung()
’
’ Reservierungsbestätigung Makro
’

Dim appOut As Object, appMail As Object, arrWort(6) As String
Dim W As Integer, Mailtext As String
If InStr(ActiveDocument.Sentences(1), „@“) = 0 Then
MsgBox „in der ersten Zeile ist kein @“
Exit Sub
End If
For W = 0 To 1
arrWort(W) = Trim(ActiveDocument.Sentences(1))
ActiveDocument.Sentences(1).Delete
Next W
For W = 2 To 2
arrWort(W) = vbLf & „vielen Dank für Ihre Anfrage vom heutigen Tag.“ _
& vbLf & vbLf & „Gerne senden wir Ihnen als PDF-Datei unsere Reservierungsbestätigung zu.“ _
& vbLf & vbLf & „Wir freuen uns, Sie am " & Replace(ActiveDocument.Sentences(1), Chr(13), „“) & " bei uns begrüßen und verwöhnen zu dürfen und wünschen Ihnen schon jetzt eine“ _
& " angenehme Anreise und einen erholsamen Aufenthalt." & _
vbLf & „Bei Fragen stehen wir Ihnen gerne jederzeit zur Verfügung.“
ActiveDocument.Sentences(1).Delete
arrWort(3) = vbLf & „Zu Ihrer Anreise:“ & vbLf & „Bitte folgen Sie dem blauen Leitsystem.“
arrWort(4) = „Gerne stellen wir für Ihren PKW einen komfortablen Stellplatz in unserer Tiefgarage zur Verfügung.“
arrWort(5) = „“ & vbLf & _
„Sollten Sie mit der Bahn anreisen, werden Sie gerne von unserem Hausdiener am Bahnhof abgeholt.“ _
& vbLf & „Bitte teilen Sie uns 1 - 2 Tage vor Reiseantritt Ihre Ankunftszeit mit.“
Next W
For W = 6 To 6
arrWort(W) = vbLf & „Freundliche Grüße“ _
& vbLf & vbLf & Replace(ActiveDocument.Sentences(1), Chr(13), „“) & vbLf & „-Reservierung-“ & vbLf & „Hotel“
ActiveDocument.Sentences(1).Delete
Next W

For W = 1 To 6
Mailtext = Mailtext & vbLf & arrWort(W)
Next W
ActiveDocument.ExportAsFixedFormat OutputFileName:=„c:\tmp\Bestaetigung.pdf“ _
, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
Set appOut = CreateObject(„Outlook.Application“)
Set appMail = appOut.CreateItem(0)
With appMail
.To = arrWort(0)
.CC = „“
.BCC = „“
.Subject = "Ihre Reservierungsbestätigung - "
.Body = Mailtext
.Attachments.Add „c:\tmp\Bestaetigung.pdf“
.Display
'.Send
End With
End Sub

Thomas_Ramel · 12. November 2019 um 14:34

Grüezi Karin

Schau dir mal diese Ausführungen hier näher an, damit solltest Du das Ganze dann eigentlich hinbekommen:

http://www.rondebruin.nl/mail/folder3/signature.htm

Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

Karin · 12. November 2019 um 14:35

Hallo Thomas,

vielen Dank für den Link, ich kam damit auch schon ein Stück weiter. Ein Problem habe ich aber noch Im Makro habe ich „normalen Text“ und die Signatur (im Netzwerk, mehrere Benutzer mit dieser Word-Doc) enthält eine Grafik und unterschiedliche Schriftgrößen. Die Signatur als .txt sieht nicht schön aus, htm oder rft wäre gut. Aber das bekomme ich (noch) nicht hin. Hast du (oder Reinhard) einen weiteren Tipp?

Hier mein aktuelles Makro:

Modul 1:

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject(„Scripting.FileSystemObject“)
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

Makro:

Option Explicit
Sub Reservierungsbestätigung()
’
’ Reservierungsbestätigung Makro
’

Dim appOut As Object, appMail As Object, arrWort(6) As String
Dim W As Integer, Mailtext As String
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String

Set OutApp = CreateObject(„Outlook.Application“)
Set OutMail = OutApp.CreateItem(0)

SigString = Environ(„appdata“) & _
„\Microsoft\Signatures\standard.txt“

If Dir(SigString) „“ Then
Signature = GetBoiler(SigString)
Else
Signature = „“
End If

On Error Resume Next

If InStr(ActiveDocument.Sentences(1), „@“) = 0 Then
MsgBox „in der ersten Zeile ist kein @“
Exit Sub
End If
For W = 0 To 1
arrWort(W) = Trim(ActiveDocument.Sentences(1))
ActiveDocument.Sentences(1).Delete
Next W
For W = 2 To 2
arrWort(W) = vbLf & „vielen Dank für Ihre Anfrage vom heutigen Tag.“ _
& vbLf & vbLf & „Gerne senden wir Ihnen als PDF-Datei unsere Reservierungsbestätigung zu.“ _
& vbLf & vbLf & „Wir freuen uns, Sie am " & Replace(ActiveDocument.Sentences(1), Chr(13), „“) & " im Hotel begrüßen und verwöhnen zu dürfen und wünschen Ihnen schon jetzt eine“ _
& " angenehme Anreise und einen erholsamen Aufenthalt." & _
vbLf & „Bei Fragen stehen wir Ihnen gerne jederzeit zur Verfügung.“
ActiveDocument.Sentences(1).Delete
arrWort(3) = vbLf & „Zu Ihrer Anreise:“ & vbLf & „Bitte folgen Sie dem blauen Leitsystem.“
arrWort(4) = „Gerne stellen wir für Ihren PKW einen komfortablen Stellplatz in unserer Tiefgarage zur Verfügung.“
arrWort(5) = „“ & vbLf & _
„Sollten Sie mit der Bahn anreisen, werden Sie gerne von unserem Hausdiener am Bahnhof abgeholt.“ _
& vbLf & „Bitte teilen Sie uns 1 - 2 Tage vor Reiseantritt Ihre Ankunftszeit mit.“
Next W
For W = 6 To 6
arrWort(W) = vbLf & „Freundliche Grüße“ _
& vbLf & vbLf & Replace(ActiveDocument.Sentences(1), Chr(13), „“) & vbLf & „-Reservierung-“ & vbLf & „Hotel“
ActiveDocument.Sentences(1).Delete
Next W

For W = 1 To 6
Mailtext = Mailtext & vbLf & arrWort(W)
Next W
ActiveDocument.ExportAsFixedFormat OutputFileName:=„c:\tmp\Bestaetigung.pdf“ _
, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
Set appOut = CreateObject(„Outlook.Application“)
Set appMail = appOut.CreateItem(0)
With appMail
.To = arrWort(0)
.CC = „“
.BCC = „“
.Subject = „Ihre Reservierungsbestätigung“
.Body = Mailtext & Signature
.Attachments.Add „c:\tmp\Bestaetigung.pdf“
.Display
'.Send
End With
End Sub

Thomas_Ramel · 12. November 2019 um 14:38

Grüezi Karin

vielen Dank für den Link, ich kam damit auch schon ein Stück
weiter. Ein Problem habe ich aber noch Im Makro habe ich
„normalen Text“ und die Signatur (im Netzwerk, mehrere
Benutzer mit dieser Word-Doc) enthält eine Grafik und
unterschiedliche Schriftgrößen. Die Signatur als .txt sieht
nicht schön aus, htm oder rft wäre gut. Aber das bekomme ich
(noch) nicht hin. Hast du (oder Reinhard) einen weiteren Tipp?

Hmmm, das zweite Beispiel im genannten Link zeigt doch die Verwendung der HTML-Signatur die auch ein Bild enthalten kann.

Beachte auch den Hinweis unmittelbar vor den Code-Zeilen:

Important : The code will not add the signature if Word is your mail editor in Outlook 2000-2003, 
you can turn this setting of in the Outlook options. No problem in 2007-2010.

Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

Karin · 12. November 2019 um 14:38

Signatur einfügen bei Outlook - Fast geschafft
Hallo Thomas,

ich habe jetzt den Text ganz in HTML umgeändert und es passt fast alles - nur das Bild in der Signatur erscheint nicht, obwohl ich es wie in deinem Link geändert habe.

Gibt es noch eine andere Möglichkeit, das Bild einzubinden (auch, weil ich sonst ja für alle Benutzer die Signatur mit Notepad ändern müsste).

So sieht es jetzt aus (der zweite Anhang ist die Grafik von der Signatur, komme damit aber auch nicht weiter):

Sub Reservierungsbestätigung()
’
’ Reservierungsbestätigung Makro
’

Dim appOut As Object, appMail As Object, arrWort(6) As String
Dim W As Integer, Mailtext As String
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String

Set OutApp = CreateObject(„Outlook.Application“)
Set OutMail = OutApp.CreateItem(0)

SigString = Environ(„appdata“) & _
„\Microsoft\Signatures\standard.htm“

If Dir(SigString) „“ Then
Signature = GetBoiler(SigString)
Else
Signature = „“
End If

On Error Resume Next

If InStr(ActiveDocument.Sentences(1), „@“) = 0 Then
MsgBox „in der ersten Zeile ist kein @“
Exit Sub
End If
For W = 0 To 1
arrWort(W) = Trim(ActiveDocument.Sentences(1))
ActiveDocument.Sentences(1).Delete
Next W
For W = 2 To 2
arrWort(W) = vbLf & "

vielen Dank für Ihre Anfrage vom heutigen Tag." _
& vbLf & vbLf & "

Gerne senden wir Ihnen als PDF-Datei unsere Reservierungsbestätigung zu." _
& vbLf & vbLf & "

Wir freuen uns, Sie am " & Replace(ActiveDocument.Sentences(1), Chr(13), „“) & " im Hotel begrüßen und verwöhnen zu dürfen und wünschen Ihnen schon jetzt eine" _
& " angenehme Anreise und einen erholsamen Aufenthalt." & _
vbLf & "

Bei Fragen stehen wir Ihnen gerne jederzeit zur Verfügung."
ActiveDocument.Sentences(1).Delete
arrWort(3) = vbLf & "

Zu Ihrer Anreise:" & vbLf & "
Bitte folgen Sie dem blauen Leitsystem."
arrWort(4) = "
Gerne stellen wir für Ihren PKW einen komfortablen Stellplatz in unserer Tiefgarage zur Verfügung."
arrWort(5) = „“ & vbLf & _
"
Sollten Sie mit der Bahn anreisen, werden Sie gerne von unserem Hausdiener am Bahnhof abgeholt." _
& vbLf & "
Bitte teilen Sie uns 1 - 2 Tage vor Reiseantritt Ihre Ankunftszeit mit."
Next W
For W = 6 To 6
arrWort(W) = vbLf & "

Freundliche Grüße
" _
& vbLf & vbLf & Replace(ActiveDocument.Sentences(1), Chr(13), „“) & vbLf & "
-Reservierung-" & vbLf & „Hotel“
ActiveDocument.Sentences(1).Delete
Next W

For W = 1 To 6
Mailtext = Mailtext & vbLf & arrWort(W)
Next W
ActiveDocument.ExportAsFixedFormat OutputFileName:=„c:\tmp\Bestaetigung.pdf“ _
, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
Set appOut = CreateObject(„Outlook.Application“)
Set appMail = appOut.CreateItem(0)
With appMail
.To = arrWort(0)
.CC = „“
.BCC = „“
.Subject = „Ihre Reservierungsbestätigung“
.HTMLBody = „“ & Mailtext & Signature
.Attachments.Add „c:\tmp\Bestaetigung.pdf“
.Attachments.Add „c:\tmp\image002.jpg“
.Display
'.Send
End With
End Sub