Outlook Signatur

Sub InsertSignature(objMail As Object, SignatureName As String)
Dim wd As Object, obSelection As Object
Dim enviro, strSigFilePath
Const wdStory = 6
Const wdParagraph = 4
Const wdGoToBookmark = -1
Const wdExtend = 1
Const wdSortByName = 0
enviro = CStr(Environ("appdata"))
strSigFilePath = enviro & "\Microsoft\Signatures\"
Set wd = objMail.GetInspector.WordEditor
Set obSelection = wd.Application.Selection
obSelection.Move wdStory, -1
obSelection.Move wdParagraph, 1
obSelection.Paragraphs.Add
obSelection.Move wdParagraph, 1
Dim oBookmark
Set oBookmark = obSelection.Bookmarks.Add("_Sig", obSelection.Range)
If Dir(strSigFilePath & SignatureName & ".htm", vbNormal)  "" Then
obSelection.InsertFile Filename:=strSigFilePath & SignatureName & ".htm", Range:="", ConfirmConversions:= _
False, Link:=False, Attachment:=False
obSelection.Goto What:=wdGoToBookmark, Name:="_Sig"
obSelection.EndKey Unit:=wdStory, Extend:=wdExtend
With wd.Bookmarks
.Add Range:=obSelection.Range, Name:="_MailAutoSig"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
obSelection.Move wdStory, -1
End If
Set obSelection = Nothing
Set oBookmark = Nothing
Set wd = Nothing
End Sub

Sub createMailWithSignature() 'von Luschi
Dim objMail As Object    'Outlook.MailItem
Dim objOL As Object
Dim oAcc As Object
Dim li As MSComctlLib.ListItem
Const olMailItem As Integer = 0
Set objOL = CreateObject("Outlook.Application")
Set objMail = objOL.CreateItem(olMailItem)
With objMail
'Absender auswählen
.SendUsingAccount = Nothing
For Each oAcc In objOL.Session.Accounts
If CStr(oAcc.SmtpAddress) = UFJ.cboM_Absender.Text Then
Set .SendUsingAccount = oAcc
End If
Next oAcc
'senden an
.To = UFJ.txtM_Mailadr.Text
'Betreff
.Subject = UFJ.cboM_Betreff_Vortext.Text
'Anhänge aus Listview hinzufügen
For Each li In UFJ.lvwMail.ListItems
If li.Checked Then
.Attachments.Add li.SubItems(2) & "\" & li.ListSubItems(1)
End If
Next
'Text
.Body = UFJ.txtM_Body.Text & vbNewLine
.Display
Call InsertSignature(objMail, "Mustermann")
End With
Set objMail = Nothing
Set objOL = Nothing
End Sub