bild in email-signatur einfügen per vba

'On Error Resume Next  

Dim depart
depart = ""  
Set objSysInfo = CreateObject("ADSystemInfo")  

strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://192.168.240.1:389/"&strUser)  
arrUser = objUser.GetEx("memberOf")  

strFullName = objUser.FullName
words = split(strFullname)
strName=words(1)
strSurname=words(0)
strTitle = objUser.Title
strDesc=objUser.description
msgBox(depart)

strCompany1 = "Firma"  
strCompany2 = "Musterstraße 1"  
strCompany3 = "A-xxxx"  
strTelP="+43 xxx"  
strFax="+43 xxx"  
strMail=LCASE(words(0)) & "." & LCASE(words(1)) & "@tzu.at"  
strLogo="h:\Vorlagen\logo_email.jpg"  
strWeb="http://www.domain.tld"  

strPhone= strTelP & objUser.TelephoneNumber
'strDisclaimer  = "This message may contain confidential and/or legally privileged information and is intended for use by the indicated addressee only. If you are not the intended addressee: (a) any disclosure, reproduction, distribution or action you take on the basis of the contents of this message (except for this instruction) is strictly prohibited; (b) please notify us immediately by reply e-mail and delete this message from your system."  

'strDisclaimer1 = "Haftungssausschluss / Disclaimer:"  
'strDisclaimer2 = "Diese Nachricht enthält vertrauliche Informationen und ist ausschließlich für den Adressaten bestimmt. Jeder Gebrauch durch Dritte ist untersagt. Falls Sie die Daten irrtümlich erhalten haben, nehmen Sie bitte Kontakt mit dem Absender auf und entfernen Sie die Daten von jedem Computer und Datenträger."  
'strDisclaimer3 = "This message contains confidential information and is intended solely for the use by the addressee. Any use of this message by a third person is prohibited. If you received this message in error, please contact the sender and delete the data from any computer and data storage."  

Set objWord = CreateObject("Word.Application")  

objword.visible=true
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
With objSelection.ParagraphFormat
    .Space1
    .SpaceAfter = 5
End With

Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

With objSelection.Font
    .Name = "Arial"  
    .Size = 8
End With

objSelection.TypeText "Mit freundlichen Grüßen"  
objSelection.TypeParagraph()
if len(strTitle) > 0 then
objSelection.TypeText strtitle & " " & strName & " " & strSurname  
else
objSelection.TypeText strName & " " & strSurname  
end if

objSelection.TypeParagraph()

With objSelection.Font
  .Name = "Arial"  
  .Size = 7.5
End With

objSelection.TypeText "( " & strDesc & " )"  
ObjSelection.TypeParagraph()

With objSelection.Font
  .Name = "Arial"  
  .Size = 8
End With

objSelection.InlineShapes.AddPicture(strLogo)
objSelection.TypeParagraph()

objSelection.TypeText strCompany1 & " "  
objSelection.TypeText strCompany2
objSelection.TypeParagraph()
objSelection.TypeText strCompany3
objSelection.TypeParagraph()

objSelection.TypeText "Tel.: " & strPhone  
objSelection.TypeParagraph()
ObjSelection.TypeText "Fax: " & strFax  
objSelection.TypeParagraph()
ObjSelection.TypeText "E-Mail: "  
objSelection.HyperLinks.Add objSelection.Range,"mailto:"& strMail,,,strMail  
objSelection.TypeParagraph()
objSelection.TypeText "Web: "  
objSelection.HyperLinks.Add objSelection.Range,"http:\\"& strWeb,,,strWeb  
'objSelection.TypeParagraph()  
'Set rngParagraph = objSelection.Paragraphs(4).Range  
'msgBox rngParagraph.Text  

Set objSelection = objDoc.Range()

objSignatureEntries.Add "Signature", objSelection  
objSignatureObject.NewMessageSignature = "Signature"  
objSignatureObject.ReplyMessageSignature = "Signature"  

objDoc.Saved = true
objWord.Quit
msgBox "Signatur Erstellt"