vbs Outlook 签名，与 2010/2016 相比，2013 的结果不同 - Selection.GoTo？

Question

我发现这个脚本使用 Word 模板和占位符来生成 Outlook 签名并在 Outlook 中设置生成的签名。 - 链接因声望不超过 10 而被删除 -

我进行了一些修改以满足我的需要，并且在 Outlook 2010 和 2016 上进行测试时效果很好。但是，我在让它与 Outlook 2013 一起工作时遇到了问题。占位符没有被替换相关信息。

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"

我发现这篇文章 - 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 的答案表明 Selection.GoTo 设置不正确。我听从了他的建议，但这并不能解决问题。

其余代码似乎可以在 2013 年使用，使用 Word 模板并将其复制到 Outlook 中并设置为签名，但占位符不会替换为活动目录信息。所以签名（对于 Outlook 2013）最终被设置为：

[姓名]

[标题]

[办公电话]

[手机]

非常感谢您的宝贵时间。

Answer 1

注释掉

On Error Resume Next

告诉我错误是由

.Selection.GoTo

在 SearchAndRep 子例程中。

以前的评论建议（现已删除）