我有一个 vbscript，它采用 word 文档模板并根据用户详细信息将一些单词更改为另一个单词。由于某种原因，很少有用户更改过程不成功，他们按原样获得模板以符合她的 Outlook 签名。我的脚本由 GPO 作为登录脚本运行，这是我的代码：
On Error Resume Next
'==================================================
'Create Outlook signature from Word template
'==================================================
'search text and replace function
Sub SearchAndRep(searchTerm, replaceTerm, objWord)
objWord.Selection.GoTo 1
With objWord.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.Text = searchTerm
.Execute ,,,,,,,,,replaceTerm
End With
End Sub
'----- Declarations -----
Const wdWord = 2
Const wdParagraph = 4
Const wdExtend = 1
Const wdCollapseEnd = 0
'--------------------------------------------------------------
'----- Modify these variables appropriately ----
'--------------------------------------------------------------
strTemplatePath = "\\DOMAINNAME\SYSVOL\scripts\"
strTemplateName = "SignTemplate.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)
strName = objUser.FullName
strTitle = objUser.Title
strPhone = objUser.TelephoneNumber
strMobile = objUser.Mobile
strCompany = objUser.Company
strEmail = objUser.mail
strWeb = objuser.wWWHomePage
'----- Apply any modifications to Active Directory fields -----
'----- Open Word template in read-only mode {..Open(filename,conversion,readonly)} -----
Set objWord = CreateObject("Word.Application")
objWord.Visible = FALSE
Set objDoc = objWord.Documents.Open(strTemplatePath & strTemplateName,,False)
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
'----- Replace template text placeholders with user specific info -----
SearchAndRep "[Name]", strName, objWord
SearchAndRep "[Title]", strTitle, objWord
if strCompany = ("blabla LTD") then
SearchAndRep "[Company]", strCompany, objWord
Else
SearchAndRepDel objWord
End if
SearchAndRep "[Phone]", strPhone, objWord
SearchAndRep "[Mobile]", ("M: " & strMobile), objWord
SearchAndRep "[email]", strEmail, objWord
'----- Replace template hyperlink placeholders with user specific info -----
'SearchAndRepHyperlink "[email]", strWeb, objDoc
'SearchAndRepHyperlink "[web]", strWeb, objDoc
'----- Set signature in Outlook -----
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Default", objSelection
objSignatureObject.NewMessageSignature = "Default"
'see note below if a different reply signature is desired
objSignatureObject.ReplyMessageSignature = "Default"
'----- Close signature template document -----
objDoc.Saved = TRUE
objDoc.Close
objWord.Quit
'-----close outlook-----
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Quit
'----- 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
'---sub for solar----
Sub SearchAndRepDel(objWord)
objWord.Selection.GoTo 1
With objWord.Selection.Find
.ClearFormatting
.Wrap = wdFindStop
.Text = "[Company]"
Do While .Execute
objWord.selection.Bookmarks("\Line").Range.Delete
Loop
End With
End Sub