VB scripts

 Скриптче за създаване на Outlook подписи от AD

 

OnErrorResumeNext

Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strCompany = objUser.Company
strPhone = objUser.telephoneNumber
strMobile = objUser.Mobile
strEmail = objUser.mail
strDepart = objUser.Department

Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.Style = "No Spacing"
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

'‘Name of Staff
objSelection.Font.Name = "Calibri"
objSelection.Font.Bold = True
objSelection.Font.Size = "12"
objSelection.Font.Color = RGB(15,36,62)
objSelection.TypeText strName
objSelection.TypeText(Chr(10))

'‘Role of Staff
objSelection.Font.Name = "Calibri"
objSelection.Font.Bold = False
objSelection.Font.Size = "10"
objSelection.Font.Color = 0
objSelection.TypeText strDepart & " " & strTitle
objSelection.TypeText(Chr(10))

'‘Company Logo (stored in network share accessed by everyone)
objSelection.InlineShapes.AddPicture("\\192.168.2.1\image001.jpg")
objSelection.TypeParagraph()

'‘Company Contact details
objSelection.Font.Color = RGB(38,38,38)
objSelection.TypeText strCompany
objSelection.TypeText(Chr(10))
objSelection.TypeText "Tel: +359(32)xxxxxx"
objSelection.TypeText(Chr(10))
objSelection.TypeText "Mob: " & strMobile
objSelection.TypeText(Chr(10))
Set objCell = objTable.Cell(10, 1) 
Set objCellRange = objCell.Range 
objCell.Select 
objselection.typeText strEmailTEXT 
Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " & strEmail, , , strEmail) 
objLink.Range.Font.Name = "Calibri"
objLink.Range.Font.Size = 10
objLink.Range.Font.Bold = false
objSelection.TypeText(Chr(11))
objSelection.Font.Color = RGB(23,54,93)
objLink = objSelection.Hyperlinks.Add(objSelection.Range,"www.site.com",,"www.site.com","www.site.com")
objSelection.TypeParagraph()
objSelection.TypeParagraph()

'environment message
'objSelection.Font.Name = "Webdings"
'objSelection.Font.Size = "14"
'objSelection.Font.Color = RGB(115,155,63)
'objSelection.TypeText "P "
'objSelection.Font.Name = "Calibri"
'objSelection.Font.Size = "9"
'objSelection.TypeText "Please consider the environment before printing this e-mail."

Set objSelection = objDoc.Range()

objSignatureEntries.Add "Standard Signature", objSelection
objSignatureObject.NewMessageSignature = "Standard Signature"
objSignatureObject.ReplyMessageSignature = "Standard Signature"

objDoc.Saved = True
objWord.Quit