Automatic Outlook Signatures with Active Directory Info

[Techmonkey]

Came across this on another forum I use and thought it could be exceptionally useful.

I have not yet tested this myself, but plenty of users on the other site have and all say it works perfectly

This is a login script which will pull information from Active Directory and automatically insert the info along with any premade text in to the users Outlook signature.

Code:

On Error Resume Next

Set objSysInfo = CreateObject("ADSystemInfo")

Set WshShell = CreateObject("WScript.Shell")

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

strName = objUser.FullName
strTitle = objUser.Description
strCred = objUser.info
strStreet = objUser.StreetAddress
strLocation = objUser.l
strPostCode = objUser.PostalCode
strPhone = objUser.TelephoneNumber
strMobile = objUser.Mobile
strFax = objUser.FacsimileTelephoneNumber
strEmail = objUser.mail

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
if (strCred) Then objSelection.TypeText strName & ", " & strCred Else objSelection.TypeText strName
objSelection.TypeParagraph()
objSelection.TypeText strTitle
objSelection.TypeText Chr(11)
objselection.TypeText Chr(11)
objSelection.TypeText "Company Name"
objSelection.TypeText Chr(11)
objSelection.TypeText strStreet
objSelection.TypeText Chr(11)
objSelection.TypeText "PHONE: " & strPhone
objSelection.TypeText Chr(11)
if (strFax) Then objSelection.TypeText "FAX: " & strFax & Chr(11)
if (strMobile) Then objSelection.TypeText "CELL: " & strMobile & Chr(11)
objSelection.TypeText "EMAIL: " & strEmail
objSelection.TypeText Chr(11)
objSelection.TypeText "________________________________"
objSelection.TypeText Chr(11)
objSelection.TypeText "CONFIDENTIALITY NOTICE"

Set objSelection = objDoc.Range()

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

objDoc.Saved = True
objWord.Quit

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
if (strCred) Then objSelection.TypeText strName & ", " & strCred Else objSelection.TypeText strName
objSelection.TypeParagraph()
objSelection.TypeText strTitle
objSelection.TypeText Chr(11)

Set objSelection = objDoc.Range()

objSignatureEntries.Add "Reply Signature", objSelection

objSignatureObject.ReplyMessageSignature = "Reply Signature"

objDoc.Saved = True
objWord.Quit

Original Author is ChrisopherO from the Spiceworks Community

[Fail Whale]

great script, have often had requests to be able to do this. From what I have seen Exchange 2010 is now able to do this natively as the transport rules support HTML formatting and AD variables, but not many people gonna be upgrading to that for a while