Ich fand dieses Skript, das eine Word-Vorlage und Platzhalter verwendet, um eine Outlook-Signatur zu generieren und die generierte Signatur in Outlook festzulegen. - Link entfernt, da ich nicht mehr als 10 Reputationen habe -vbs Outlook Signatur, abweichendes Ergebnis 2013 gegenüber 2010/2016 - Selection.GoTo?
Ich habe ein paar Änderungen an meinen Bedürfnissen vorgenommen und es funktionierte großartig beim Testen auf Outlook 2010 und 2016. Allerdings hatte ich Probleme mit der Arbeit Outlook 2013. Die Platzhalter werden nicht durch die relevanten Informationen ersetzt.
On Error Resume Next
Const wdWord = 2
Const wdParagraph = 4
Const wdExtend = 1
Const wdCollapseEnd = 0
strTemplatePath = "\\server\dir\"
strTemplateName = "SignatureTemplate.docx"
strReplyTemplateName = "SignatureTemplateReply.docx"
'----- Connect to AD and get user info -----'
Set objSysInfo = CreateObject("ADSystemInfo")
Set WshShell = CreateObject("WScript.Shell")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strFirstname = objUser.FirstName
strLastName = objUser.givenName
strDepartment = objUser.Department
strInitials = objUser.initials
strName = objUser.FullName
strTitle = objUser.Title
strDescription = objUser.Description
strOffice = objUser.physicalDeliveryOfficeName
strCred = objUser.info
strStreet = objUser.StreetAddress
strLocation = objUser.l
strPostCode = objUser.PostalCode
strPhone = objUser.TelephoneNumber
strMobile = objUser.Mobile
strFax = objUser.FacsimileTelephoneNumber
strEmail = objUser.mail
strWeb = ""
'New Signature
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(strTemplatePath & strTemplateName,,True)
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
SearchAndRep "[Name]", strName, objWord
If strTitle = "" Then
SearchAndRep "[Title]", (objDoc.Bookmarks("title").Range.Paragraphs(1).Range.Delete), objDoc
Else SearchAndRep "[Title]", strTitle, objWord
End If
If strDepartment = "" Then
SearchAndRep "[Department]", (objDoc.Bookmarks("department").Range.Paragraphs(1).Range.Delete), objDoc
Else SearchAndRep "[Department]", strDepartment, objWord
End If
SearchAndRep "[Phone]", strPhone, objWord
If strMobile = "" Then
SearchAndRep "[Mobile]", (objDoc.Bookmarks("mobile").Range.Paragraphs(1).Range.Delete), objDoc
Else SearchAndRep "[Mobile]", strMobile, objWord
End If
SearchAndRep "[Fax]", strFax, objWord
SearchAndRep "[OfficePhone]", strOfficePhone, objWord
SearchAndRep "[email]", strEmail, objWord
SearchAndRep "[web]", strWeb, objWord
If strOffice = "" Then
SearchAndRep "[Office]", (objDoc.Bookmarks("office").Range.Paragraphs(1).Range.Delete), objDoc
Else SearchAndRep "[Office]", strOffice, objWord
End If
SearchAndRepHyperlink "[email]", strWeb, objDoc
SearchAndRepHyperlink "[web]", strWeb, objDoc
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Full Signature", objSelection
objSignatureObject.NewMessageSignature = "Full Signature"
'see note below if a different reply signature is desired
'objSignatureObject.ReplyMessageSignature = "Reply Signature"
objDoc.Saved = TRUE
objDoc.Close
objWord.Quit
'______________________
'Reply Signature
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(strTemplatePath & strReplyTemplateName,,True)
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
SearchAndRep "[Name]", strName, objWord
If strTitle = "" Then
SearchAndRep "[Title]", (objDoc.Bookmarks("title").Range.Paragraphs(1).Range.Delete), objDoc
Else SearchAndRep "[Title]", strTitle, objWord
End If
If strDepartment = "" Then
SearchAndRep "[Department]", (objDoc.Bookmarks("department").Range.Paragraphs(1).Range.Delete), objDoc
Else SearchAndRep "[Department]", strDepartment, objWord
End If
SearchAndRep "[Phone]", strPhone, objWord
If strMobile = "" Then
SearchAndRep "[Mobile]", (objDoc.Bookmarks("mobile").Range.Paragraphs(1).Range.Delete), objDoc
Else SearchAndRep "[Mobile]", strMobile, objWord
End If
SearchAndRep "[Fax]", strFax, objWord
SearchAndRep "[OfficePhone]", strOfficePhone, objWord
SearchAndRep "[email]", strEmail, objWord
SearchAndRep "[web]", strWeb, objWord
If strOffice = "" Then
SearchAndRep "[Office]", (objDoc.Bookmarks("office").Range.Paragraphs(1).Range.Delete), objDoc
Else SearchAndRep "[Office]", strOffice, objWord
End If
SearchAndRepHyperlink "[email]", strWeb, objDoc
SearchAndRepHyperlink "[web]", strWeb, objDoc
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Reply Signature", objSelection
objSignatureObject.ReplyMessageSignature = "Reply Signature"
objDoc.Saved = TRUE
objDoc.Close
objWord.Quit
'----- Subrouting to search and replace template text placeholders -----
Sub SearchAndRep(searchTerm, replaceTerm, WordApp)
WordApp.Selection.GoTo 1
With WordApp.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.Text = searchTerm
.Execute ,,,,,,,,,replaceTerm
End With
End Sub
'----- Subrouting to search and replace template hyperlink placeholders -----
' Note this can be picky...if it does not work re-create hyperlink in the template
Sub SearchAndRepHyperlink(searchLink, replaceLink, WordDoc)
Set colHyperlinks = WordDoc.Hyperlinks
For Each objHyperlink in colHyperlinks
If objHyperlink.Address = searchLink Then
objHyperlink.Address = replaceLink
End If
Next
End Sub
'WScript.Echo "Signature set"
fand ich diese Beitrag - https://social.msdn.microsoft.com/Forums/office/en-US/67184929-d7da-4fba-875b-0e1371f46f2f/vbscript-for-outlook-signature-not-work-with-office-2013?forum=worddev wo die Antwort vorgeschlagen, dass der Selection.GoTo nicht richtig eingestellt wurde. Ich folgte seinem Vorschlag, aber das würde das Problem nicht lösen.
Der Rest des Codes scheint auf 2013 zu funktionieren, die Wordvorlage wird verwendet und in Outlook kopiert und als Signatur festgelegt, aber die Platzhalter werden nicht durch die Active Directory-Informationen ersetzt. So ist die Signatur (für Outlook 2013) endet als gesetzt wie:
[Name]
[Titel]
[Office]
[Mobile]
Vielen Dank für deine Zeit.