问outlook签名模板不更改vbscript

EN

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