Email signatures

Some time ago, it was suggested that we should have an agreed format for Email signatures across the company. Unfortunately, it took some time to get agreement on what format we should use. I could go into the details of this, but it's pretty boring; for example, the discussions on the font to be used seemed to take forever. Suffice to say that there were numerous discussions and it has taken quite a while for the final decision.

There are numerous sample VB scripts out on the Internet for producing an email signature, but none seemed to achieve what we wanted. I did think about trying PowerShell, but I don't yet know enough to be able to do the work using that. As I've used VB script on and off for a few years, it made sense to try and use that, at least for the time being.

The script has taken a little while to put together to make sure that it meets the needs of the business. It takes data from the Active Directory, formats it and places it in the required location. It also inserts a company logo, and there is a bit of conditional text to insert other logos; this is because we attend a number of trade shows, and like to promote these on our emails.

There is one slight issue; the email has to go out in Rich Text Format. If it goes as .HTML, the lines get double spaced. This is just because of the way that it gets rendered and I haven't found a way around this. Also if it goes out as plain text, the logo doesn't get inserted. It works by using Word - it extracts the AD data and sets the sig in Word before saving it in Outlook.

I'm putting the script below as I am quite pleased with it and the results; if it would be of any help, please feel free to make use of it. Just copy the text, place in a text file, save it and then change the extension to .vbs - I haven't tested it with all versions of software, but I have tried with Outlook 2003 / 2007 / 2010 on Exchange 2003 (on Server 2003), on PCs running Windows XP and Windows 7 and it worked in each case.

(Note that I have removed the specific details of our company so that it is a generic script; you would then have to modify it to show your own details.)

Enjoy!

====================

On Error Resume Next

Set objSysInfo = CreateObject("ADSystemInfo")

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

strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strCompany = objUser.Company
strOffice = objUser.physicalDeliveryOfficeName
strPhone = objUser.telephoneNumber
strFax = objUser.faxNumber
strMob = objUser.Mobile
strAddrs1 = "Site 1 Address"
strAddrs2 = "Site 2 Address"
strAddrs3 = "Site 3 Address"
strWeb = "www.domain.net"
Logo = "\\server\share\logo.jpg"
ShowLogo = "\\server\share\show1.jpg"

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 = "Arial"
objSelection.Font.Size = "10"

objSelection.InlineShapes.AddPicture(Logo)
objSelection.TypeParagraph()
objSelection.TypeParagraph()

objSelection.TypeText strName & ", " & strTitle & Chr(10)
objSelection.TypeText strDepartment & ", " & strCompany & ", " & strOffice & Chr(10)
if strOffice = "Site1" then
objSelection.TypeText strAddrs1
end if
if strOffice = "Site2" then
objSelection.TypeText strAddrs2
end if
if strOffice = "Site3" then
objSelection.TypeText strAddrs3
end if
objSelection.TypeText strOffAddrs & Chr(10)
objSelection.TypeText "Tel:" & " " & strPhone & Chr(10)
objSelection.TypeText "Fax:" & " " & strFax & Chr(10)

if strMob <> "" then
objSelection.TypeText "Mob:" & " " & strMob
end if

objSelection.TypeParagraph()
objSelection.TypeText strWeb & Chr(13)
objSelection.TypeParagraph()
objSelection.TypeParagraph()

if strOffice = "Site1" then

end if
if strOffice = "Site2" then
objSelection.InlineShapes.AddPicture(ShowLogo)
end if
if strOffice = "Site3" then

end if


Set objSelection = objDoc.Range()

objSignatureEntries.Add "AD Signature", objSelection
objSignatureObject.NewMessageSignature = "AD Signature"

objDoc.Saved = True
objWord.Quit