AD domain 环境下VBS自动生成邮件签名

使用VBS自动生成邮件签名

脚本使用环境：在AD域网络环境下，集团有上千邮件帐号，邮件签名是一比较难以管控工作内容，邮件签名内容一般包含1-问候语句，2-用户名 ，3-部门及职务，4-公司名称，5-固话，手机方式，6-公司Logo图片，7告警及声明等，因为各种原因工程师给用户设置好签名，用户自己也会修改邮件签名，用户修改后的签名可能不符合公司组织架构职务等。
用VBS给用户自动生成签名，通过AD域组策略在用户端执行，这样可以解决，１：IT工程师不需要再给用户手动设置签名，2：用户端自己修改了签名之后，用户重新登入之后，用户的签名又会自动更改过来

以下是一邮件签名VBS脚本模板，

On Error Resume Next
Dim objSignature
Dim userMessage
Set objSignature =CreateObject("Scripting.Dictionary")
Set userMessage =CreateObject("Scripting.Dictionary")

'邮件格式
'Best Regards, 固定一行
'用户名，可以中是文也可能是英文
'职务 可能是中文也可能是英文
'公司名称
'固话，手机方式等
'公司Logo图片
'公司网址
'固定告警



Function GetUser()	'从AD域获取用户信息
	Set objSysInfo = CreateObject("ADSystemInfo")
	strUser = objSysInfo.UserName
	Set objUser = GetObject("LDAP://" & strUser)

	tmp = split(objUser.FullName,"(")                'objUser.FullName 类似:liu d.h. (刘德华)
	userMessage("EnName") = tmp(0)
	userMessage("EnTitle")   	 = objUser.Title 
    userMessage("EnDepartment")  = objUser.Department
	userMessage("EnDepartment") = objUser.Department
	userMessage("EnPhone") = "Tel: " + objUser.telephoneNumber + " / Fax: " + objUser.facsimileTelephoneNumber
	
	userMessage("EnMobile") =objUser.company
	userMessage("EnCompany") =objUser.company
	userMessage("CnCompany") =objUser.company
    userMessage("gidNumber") = objUser.gidNumber
    userMessage("co") = objUser.co
	userMessage("initials") =objUser.initials
End Function


Function BaseEnSignature() '基本英文签文信息,
	objSignature("Regard") = "Best Regard"
	objSignature("Name") = userMessage("EnName") 
	objSignature("Title")   =  userMessage("EnTitle")
	objSignature("Department")=userMessage("EnDepartment")
	objSignature("Company") =userMessage("EnCompany")
	objSignature("Phone") = userMessage("EnPhone")
	objSignature("Mobile")= userMessage("EnMobile") 
End Function
Function BaseCnSignature() '中文邮件签名,有其它签名规则都可以在后面加
	objSignature("Regard") = "此致敬礼"
End Function
Function Signature3() '定义邮件签名规则,有其它签名规则都可以在后面加
	objSignature("Regard") = "此致敬礼"
End Function

Function NewLine(Name,Value,Color1,Color2,Color3)   '编辑字体大小颜色等参数
	if trim(Value) <> "" then
		objSelection.Font.Name = Name '"Calibri"
		objSelection.Font.Bold = False
		objSelection.Font.Size = "11"
		objSelection.Font.Color = RGB(Color1,Color2,Color3)
		objSelection.TypeText Value
		objSelection.TypeText(Chr(13))
	End if
End Function

Function SaveSignature()
	Set objSelection = objDoc.Range()
	objSignatureEntries.Add "New Signature", objSelection
	objSignatureObject.NewMessageSignature = "New Signature"
	objSignatureObject.ReplyMessageSignature = "New Signature"
	objDoc.Saved = True
	objWord.Quit
End Function

Function NewSignature():
	NewLine "Calibri",objSignature("Regard"),15,36,62
	NewLine "Calibri",objSignature("Name"),15,36,62
	NewLine "Calibri",objSignature("Title"),15,36,62
	NewLine "Calibri",objSignature("Department"),15,36,62 
	NewLine "Calibri",objSignature("Company"),15,36,62
	NewLine "Calibri",objSignature("Phone"),15,36,62
	NewLine "Calibri",objSignature("Mobile"),15,36,62
End Function


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


GetUser	'获取用户需要用到的签名信息

if userMessage("gidNumber") = "0" then	'判断用户使用哪个签名规划	
	BaseEnSignature						'组合签名字典项
end if

NewSignature
SaveSignature