ing66-Code

I do lots of little VB coding to automate tasks at work. Work is primarily a windows environment.

I was asked to make a standard signature for everyone in the office.
I thought I could do it at the exchange server.
But you can't.
I though you could do it via a Group Policy
Forget it.
I then thought I'd find where it is stored in the Registry.
No dice, the registry key changes with different outlook versions.

Outlook signatures are stored locally somewhere in the current user's hard drive. Which explains why they lose the signature when changing computers.

We have Active Directory going on, so most of the data that is needed is stored on the active directory / LDAP

So I wrote the following and have it run each time at logon (good ol' logon script):

On Error Resume Next

Set objSysInfo = CreateObject("ADSystemInfo")

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

This just takes advantage of the fact that the logged in user is known. So we connect to LDAP as that user.


strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strEmail = objUser.mail
strPhone = objUser.telephoneNumber
strFax = objUser.facsimileTelephoneNumber
strMobile = objUser.mobile
strst = objUser.st
strSreetAddress = objUser.StreetAddress
strPostalCode= objUser.PostalCode
strl= objUser.l



Get all the data you need from the LDAP

BTW I found a great site with more LDAP to outlook info than you can shake a stick at:
http://www.openldap.org/faq/data/cache/294.html

Set objWord = CreateObject("Word.Application")


Here is the tricky part. Yes word. Use word to make and set the outlook signature. Not outlook. You'll go crazy trying to figure out why it doesn't stick. But it won't. You code it so it makes the signature in outlook, it looks good, next time you log in it is changed.


Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObject.EmailSignatureEntries


Before we go on: We have the extension instead of the phone number (we all have the same number in this company, unless we are in the second office, which all has the same number as well)

Formatting is optional, but here is how you format word in VB:


objSelection.Font.Name = "Arial"
objSelection.Font.Color = wdColorGray50
objSelection.Font.Size = 8
objSelection.Font.AllCaps = True


We have 2 offices, some people want the fax number on it, some want a different fax number, some want their mobile number.
So you do lots of conditionals.. Big deal (I used the state as an indicator of which office the person is at)


objSelection.TypeText strName & " | Company Name | "
objSelection.TypeText strSreetAddress & " " & strl & " " & strst & " " &strPostalCode &" | "
objSelection.Font.Bold = True
If strst = "NY" then
objSelection.TypeText "P: Phone number 1 X "

Else
objSelection.TypeText "P: Phone number 2 X "
End If
objSelection.TypeText strPhone & " | "
objSelection.Font.Bold = False

If strFax <> "" Then objSelection.TypeText "F: " & strFax & " | " End If
If strMobile <> "" then objSelection.TypeText "M: " & strMobile & " | " End If
IF strst ="NY" Then
objSelection.TypeText "Los Angeles: Other phone number 1"
Else
objSelection.TypeText "New York: Other phone number 2"
End If

Set objSelection = objDoc.Range()

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

objDoc.Saved = True
objWord.Quit

That's it
Thanks scripting guys for most of the code