outlook簽名模板不改變vbscript

我有一個vbscript採取Word文檔模板，並改變一些字到另一個用戶的細節基地。由於某些原因，很少有用戶的更改過程不成功，他們將模板按原樣歸於她的Outlook簽名。我的腳本由GPO 這個運行的登錄腳本是我的代碼：outlook簽名模板不改變vbscript

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

來源

2014-02-24 Tzuriel Yamin

它很好地工作辦公室2010和2007年我有這個問題只與辦公室2013 –

確保所有用戶都具有讀模板文件的寫權限SignTemplate.docx

來源

2014-06-05 07:49:03 sherbeny

謝謝，這是靈魂。 –

outlook簽名模板不改變vbscript

回答

相關問題