A long time ago I created a useful script to make create a default signature. This evolved over the years and when I was asked if it were possible to standardise all our signatures across each office and company I thought why not make use of Active Directory and gather most details from there.

So the below script looks up the logged on user and then matches it against the company they work for and then adds some extra details that we wanted, apart from that its pretty straight forward.

You need to have Word and Outlook installed to run this script.

I run the script on user logon so it sets up email signatures for the user.

' Auto Add Email Signature based on Active Directory Information
' Created by Iain Gibson 9/02/2007

on error resume next

' Collect Logged on user details and connect to AD
Set objSysInfo = CreateObject("ADSystemInfo")

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

' Grab some of the users details from AD
strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strCompany = objUser.Company
strPhone = objUser.telephoneNumber
strFax = objUser.faxNumber
strEmail = objUser.mail

' Choose which company they work for and ammend extra signature lines
Select Case strCompany
case "COMPANY1"
strPre = "PRE NAME DETAILS "
strExtra = "POST NAME DETAILS"
strWeb = "WEBSITE"
strAddress = "SHORT ADDRESS FORM"

case "COMPANY2"
strPre = "PRE NAME DETAILS "
strExtra = "POST NAME DETAILS"
strWeb = "WEBSITE"
strAddress = "SHORT ADDRESS FORM"

case "COMPANY3"
strPre = "PRE NAME DETAILS "
strExtra = "POST NAME DETAILS"
strWeb = "WEBSITE"
strAddress = "SHORT ADDRESS FORM"end select

' Create MS Word Document
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()

' Start Text area selection & choose email signature options
Set objSelection = objWord.Selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

' Setup Font and type style & Include variables from AD
objSelection.Font.Name = "Palatino Linotype"
objSelection.Font.Size = 12
objSelection.Font.Bold = 1
objSelection.TypeText strName
objSelection.TypeParagraph()
objSelection.Font.Italic = 1
objSelection.Font.Bold = 0
objSelection.Font.Size = 10
objSelection.TypeText strTitle
objSelection.TypeParagraph()
objSelection.TypeText strDepartment
objSelection.TypeParagraph()
objSelection.Font.Bold = 1
objSelection.Font.Italic = 0
objSelection.Font.Size = 12
objSelection.TypeText strPre & strCompany & ", "
objSelection.Font.Bold = 0
objSelection.Font.Size = 10
objSelection.TypeText strExtra
objSelection.TypeParagraph()
objSelection.TypeText strAddress
objSelection.TypeParagraph()
objSelection.TypeText "Email: " & strEmail
objSelection.TypeParagraph()
objSelection.TypeText "Web: " & strWeb
objSelection.TypeParagraph()
objSelection.TypeText "Tel: " & strPhone & "  Fax: " & strFax
objSelection.TypeParagraph()

Set objSelection = objDoc.Range()

' Update Outlook with the new signature and set as default
objSignatureEntries.Add "AD Signature", objSelection
objSignatureObject.NewMessageSignature = "AD Signature"
objSignatureObject.ReplyMessageSignature = "AD Signature"

objDoc.Saved = True
objWord.quit