为Outlook中的VBScript

大家好，第一次发布...这里是我想要做什么...

我有一个Word文档，作为一个模板，我想用我的用户的电子邮件签名。我想要做的就是把东西一起改变模板和编辑文件，把信息从AD中的登录脚本运行。我的一部分工作......我可以复制模板的代码，更改信息，并保持它在他们的机器上的签名部分...我似乎无法做什么的，是得到它然后应用前景签名模板文件...

这里是代码...

On Error Resume Next

 

Dim strReadDocName

 

Set objSysInfo = CreateObject("ADSystemInfo")

Set WshShell = CreateObject("WScript.Shell")

Set FileSys =CreateObject("Scripting.FileSystemObject")

 



vAPPDATA = WshShell.ExpandEnvironmentStrings("%APPDATA%") 

 



FileSys.CopyFile "\\xxx\NETLOGON\sig_files\xxx\xxx.docx", vAPPDATA & "\Microsoft\Signatures\xxx.docx"

 



 



strUser = objSysInfo.UserName

Set objUser = GetObject("LDAP://" & strUser)

 

strName = objUser.FullName

strTitle = objUser.Title

strCred = objUser.info

strStreet = objUser.StreetAddress

strLocation = objUser.l

strState = objUser.st

strPostCode = objUser.PostalCode

strPhone = objUser.TelephoneNumber

strMobile = objUser.Mobile

strFax = objUser.FacsimileTelephoneNumber

strEmail = objUser.mail

 



 



 



 

Set objWord = CreateObject("Word.Application")

Set objDoc = objWord.Documents.Add()

Set objSelection = objWord.Selection

Set objEmailOptions = objWord.EmailOptions

Set objSignatureObject = objEmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

 



 



objWord.Visible = FALSE

 

strReadDocName = vAPPDATA & "\Microsoft\Signatures\xxx.docx"

 



' Open this doc and copy the content to the clipboard then close the doc file



 objWord.Documents.Open strReadDocName

 With objWord.Documents.Application.Selection.Find

 	'.ClearFormatting

 	.Text = "DisplayName"

 	.Replacement.Text = strName

 	.Forward = True

 	.Wrap = 0

 	.Format = False

 	'.MatchCase = False

 	.MatchWholeWord = True

 End With

 

 objWord.Documents.Application.Selection.Find.Execute ,,,,,,,,,,2

 

 With objWord.Documents.Application.Selection.Find

 	'.ClearFormatting

 	.Text = "Title"

 	.Replacement.Text = strTitle

 	.Forward = True

 	.Wrap = 0

 	.Format = False

 	'.MatchCase = False

 	.MatchWholeWord = True

 End With

 

 objWord.Documents.Application.Selection.Find.Execute ,,,,,,,,,,2

 

 With objWord.Documents.Application.Selection.Find

 	'.ClearFormatting

 	.Text = "Address"

 	.Replacement.Text = strStreet

 	.Forward = True

 	.Wrap = 0

 	.Format = False

 	'.MatchCase = False

 	.MatchWholeWord = True

 End With

 

 objWord.Documents.Application.Selection.Find.Execute ,,,,,,,,,,2

 

 With objWord.Documents.Application.Selection.Find

 	'.ClearFormatting

 	.Text = "City"

 	.Replacement.Text = strLocation

 	.Forward = True

 	.Wrap = 0

 	.Format = False

 	'.MatchCase = False

 	.MatchWholeWord = True

 End With

 

 objWord.Documents.Application.Selection.Find.Execute ,,,,,,,,,,2

 

 With objWord.Documents.Application.Selection.Find

 	'.ClearFormatting

 	.Text = "State"

 	.Replacement.Text = strState

 	.Forward = True

 	.Wrap = 0

 	.Format = False

 	'.MatchCase = False

 	.MatchWholeWord = True

 End With

 

 objWord.Documents.Application.Selection.Find.Execute ,,,,,,,,,,2

 

 With objWord.Documents.Application.Selection.Find

 	'.ClearFormatting

 	.Text = "Zip"

 	.Replacement.Text = strPostCode

 	.Forward = True

 	.Wrap = 0

 	.Format = False

 	'.MatchCase = False

 	.MatchWholeWord = True

 End With

 

 objWord.Documents.Application.Selection.Find.Execute ,,,,,,,,,,2

 

 With objWord.Documents.Application.Selection.Find

 	'.ClearFormatting

 	.Text = "TelephoneNumber"

 	.Replacement.Text = strPhone

 	.Forward = True

 	.Wrap = 0

 	.Format = False

 	'.MatchCase = False

 	.MatchWholeWord = True

 End With

 

 objWord.Documents.Application.Selection.Find.Execute ,,,,,,,,,,2

 

 With objWord.Documents.Application.Selection.Find

 	'.ClearFormatting

 	.Text = "FaxNumber"

 	.Replacement.Text = strFax

 	.Forward = True

 	.Wrap = 0

 	.Format = False

 	'.MatchCase = False

 	.MatchWholeWord = True

 End With

 

 objWord.Documents.Application.Selection.Find.Execute ,,,,,,,,,,2

 

 With objWord.Documents.Application.Selection.Find

 	'.ClearFormatting

 	.Text = "EmailAddress"

 	.Replacement.Text = strEmail

 	.Forward = True

 	.Wrap = 0

 	.Format = False

 	'.MatchCase = False

 	.MatchWholeWord = True

 End With

 

 objWord.Documents.Application.Selection.Find.Execute ,,,,,,,,,,2

 

 objWord.ActiveDocument.Save

 



Set objSelection = objDoc.Range()

 

objSignatureEntries.Add "Full Signature", objSelection

objSignatureObject.NewMessageSignature = "Full Signature"

 

'objDoc.Saved = True

'objWord.Quit



 

Set objEmailOptions = objWord.EmailOptions

Set objSignatureObject = objEmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

 

Set objSelection = objDoc.Range()

 

objSignatureEntries.Add "Reply Signature", objSelection

 

objSignatureObject.ReplyMessageSignature = "Reply Signature"

objWord.ActiveDocument.Close

objDoc.Saved = True

objWord.Quit