Experiments with VBScript – Outlook Signature Generation

Today I have been working on a VBScript to automatically generate outlook signatures via login script / GPO.

The script pulls all the information directly from Active-Directory and creates a fully formatted signature directly within outlook.

A lot of credit should go to the creator of this script for the starting point: http://community.spiceworks.com/scripts/show/27-set-up-outlook-signatures-with-active-directory-information

From this script I added:

• Logging
• Check to see if it has run before, if so it quits without re-generating the script
• /reload switch – forces the script to re-run
• Hyperlinks

Still to do:

• Pull regulatory text from an external file
• Make the script easier to edit, more variables, less hard-coded text
• Option to lock the signature and prevent changes
• Centralised reporting.
• Error handling
• Required fields

I hope to eventually use this script within my company.

Here it is so far:

‘cscript createSignature.vbs (/reload) – /reload forces script to run even if %userprofile%\signature.txt exists.

On Error Resume Next

‘accept external variables
Dim Arg, var1
Set Arg = Wscript.Arguments
var1 = Arg(0)

Set fso = CreateObject(“Scripting.FileSystemObject”)
Set WshShell = CreateObject(“WScript.Shell”)
userProfilePath = WshShell.ExpandEnvironmentStrings(“%UserProfile%”) ‘returns the Users local profile location
successFilePath = userProfilePath & “\signature.txt” ‘create path to save the log/completion file to

If fso.FileExists(successFilePath) = 0 or var1 = “/reload” Then ‘checks user profile for signature.txt, if the file exists this script has already been run. Script would then exit.
Set objSysInfo = CreateObject(“ADSystemInfo”)
strUser = objSysInfo.UserName ‘returns current user account
Set objUser = GetObject(“LDAP://” & strUser) ‘queries active directory for user account

‘set variables
strName = objUser.FullName
strTitle = objUser.Description ‘job title
strCred = objUser.info ‘job title
strStreet = objUser.StreetAddress
strLocation = objUser.l ‘Town name
strPostCode = objUser.PostalCode ‘postcode
strPhone = objUser.TelephoneNumber ‘phone number
strMobile = objUser.Mobile ‘mobile number
strFax = objUser.FacsimileTelephoneNumber ‘fax number
strEmail = objUser.mail ‘email address
strCompany = objUser.company ‘company name
strRegulationTextFountain = “” ‘regulatory text
strRegulationTextMYSIPP = “”
‘—–

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

objSelection.Font.Name = “Calibri” ‘defines font for signature
objSelection.Font.Size = 11 ‘font size
objSelection.Font.Color = RGB(140,140,140)
objSelection.Font.Bold = True
if (strCred) Then objSelection.TypeText strName & “, ” & strCred Else objSelection.TypeText strName ‘not sure what this does
objselection.TypeText Chr(11) ‘line space
objSelection.TypeText strTitle ‘inserts job title
objselection.TypeText Chr(11) ‘line space
objSelection.TypeText strCompany ‘inserts Company name
objSelection.Font.Bold = False
objSelection.TypeText Chr(11) ‘line space
objSelection.TypeText Chr(11) ‘line space
objSelection.TypeText strStreet & ” | ” ‘inserts street address
objSelection.TypeText strLocation & ” | ” ‘inserts Town name
objSelection.TypeText strPostCode & ” | ” ‘inserts Postcode
‘inserts web address based on company name as hyperlinks
if StrComp(LCase(strCompany), “company name 1″) = 0 Then ObjDoc.Hyperlinks.Add ObjSelection.Range, “http://wwwcompanywebsite.co.uk/”,,, “www.companywebsite.co.uk”
if StrComp(LCase(strCompany), “company name 2″) = 0 Then ObjDoc.Hyperlinks.Add ObjSelection.Range, “http://www.companywebsite2.com/”,,, “www.companywebsite2.com”

objSelection.TypeText Chr(11) ‘line space
objSelection.TypeText “t: ” & strPhone & ” | ” ‘telephone number
if (strFax) Then objSelection.TypeText “f: ” & strFax & ” | ” ‘fax number
if (strMobile) Then objSelection.TypeText “m: ” & strMobile & ” | ” ‘mobile number
objSelection.TypeText “e: “
ObjDoc.Hyperlinks.Add ObjSelection.Range, “mailto:” & strEmail,,, strEmail ‘email address as a hyperlink
objSelection.TypeText Chr(11) ‘line space
objSelection.TypeText Chr(11) ‘line space
objSelection.Font.Size = 9 ‘font size
if StrComp(LCase(strCompany), “company name”) = 0 Then objSelection.TypeText strRegulationTextFountain ‘insert regulatory text
if StrComp(LCase(strCompany), “company name 2″) = 0 Then objSelection.TypeText strRegulationTextMYSIPP

Set objSelection = objDoc.Range()

objSignatureEntries.Add “Full Signature”, objSelection
objSignatureObject.NewMessageSignature = “Full Signature”

objDoc.Saved = True
objWord.Quit

‘Generate reply signature
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

objSelection.Font.Name = “Calibri” ‘defines font for signature
objSelection.Font.Size = 11 ‘font size
objSelection.Font.Color = RGB(140,140,140)
objSelection.Font.Bold = True
if (strCred) Then objSelection.TypeText strName & “, ” & strCred Else objSelection.TypeText strName
objselection.TypeText Chr(11) ‘line space
objSelection.TypeText strTitle ‘inserts job title
objselection.TypeText Chr(11) ‘line space
objSelection.Font.Bold = False

‘objSelection.TypeText Chr(11) ‘line space
objSelection.TypeText “t: ” & strPhone & ” | ” ‘telephone number
if (strFax) Then objSelection.TypeText “f: ” & strFax & ” | ” ‘fax number
if (strMobile) Then objSelection.TypeText “m: ” & strMobile & ” | ” ‘mobile number
objSelection.TypeText “e: “
ObjDoc.Hyperlinks.Add ObjSelection.Range, “mailto:” & strEmail,,, strEmail ‘email address as a hyperlink
objSelection.TypeText Chr(11) ‘line space
objSelection.TypeText Chr(11) ‘line space
objSelection.Font.Size = 9 ‘font size
if StrComp(LCase(strCompany), “company name”) = 0 Then objSelection.TypeText strRegulationTextFountain

Set objSelection = objDoc.Range()
objSignatureEntries.Add “Reply Signature”, objSelection
objSignatureObject.ReplyMessageSignature = “Reply Signature”
objDoc.Saved = True
objWord.Quit

‘Generate log / completion file
Set SuccessFile = fso.CreateTextFile(successFilePath,True)
SuccessFile.WriteLine(“Signature Created | ” & Date() & ” | ” & Time())
SuccessFile.WriteLine(“——————————————”)
SuccessFile.WriteLine(“Name: ” + strName)
SuccessFile.WriteLine(“Job Title: ” + strTitle)
SuccessFile.WriteLine(“Job Title 2: ” + strCred)
SuccessFile.WriteLine(“Street Address: ” + strStreet)
SuccessFile.WriteLine(“Town: ” + strLocation)
SuccessFile.WriteLine(“Postcode: ” + strPostCode)
SuccessFile.WriteLine(“Phone Number: ” + strPhone)
SuccessFile.WriteLine(“Mobile Number: ” + strMobile)
SuccessFile.WriteLine(“Fax Number: ” + strFax)
SuccessFile.WriteLine(“E-mail Address: ” + strEmail)
SuccessFile.Write(“Company Name: ” + strCompany)
SuccessFile.Close
End If