Outlook signature script to poll if user has certifications or other credentials and add to signature

I have a outlook signature vbscript that grabs info from AD and automatically creates a signature.  There are some users that have certifications or other credentials that I would like to display.  Is there an easy way to do this that I am just overlooking?

I just want to put it next to or under their title.  Right now you can see one hard coded but I would like it to pull it from somewhere else.

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 = "calibri"
objSelection.Font.Size = 10
objSelection.TypeText "If you have any other questions about this, or need any further assistance, please do not hesitate to email or call."
objSelection.TypeText Chr(11)
objSelection.TypeText Chr(11)
objSelection.TypeText "Thank you,"
objSelection.TypeText Chr(11)
objSelection.TypeText Chr(11)
if (strCred) Then objSelection.TypeText strName & ", "
objSelection.TypeText Chr(11)
objSelection.TypeText strTitle
objSelection.TypeText Chr(11)
objSelection.TypeText "MCITP Enterprise Admin |MCTS|MCSA – Sec |MCSE – Sec |MCP|CompTIA A+, Net+ & Sec+ Certified"
objSelection.TypeText Chr(11)
objSelection.TypeText "BUSINESS NAME"
objSelection.TypeText Chr(11)
objSelection.TypeText "ADDRESS"
objSelection.TypeText Chr(11)
objSelection.TypeText "555.555.5555 "
objSelection.TypeText "x" & strPhone
objSelection.TypeText Chr(11)

Set objRange = objSelection.Range
Set objLink = objDoc.Hyperlinks.Add(objRange, " http://www.website.com ",,, "www.website.com")
objSelection.TypeText Chr(9) 
Set objRange = objSelection.Range
Set objLink = objDoc.Hyperlinks.Add(objRange, " http://www.facebook.com ",,, "www.facebook.com")
Set objSelection = objDoc.Range()

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

objDoc.Saved = True

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.TypeText "If you have any other questions about this, or need any further assistance, please do not hesitate to email or call."
objSelection.TypeText Chr(11)
objSelection.TypeText Chr(11)
objSelection.TypeText "Thank you,"
objSelection.TypeText Chr(11)
objSelection.TypeText Chr(11)
if (strCred) Then objSelection.TypeText strName & ", "
objSelection.TypeText Chr(11)
objSelection.TypeText strTitle
objSelection.TypeText Chr(11)
objSelection.TypeText "BUSINESS NAME"
objSelection.TypeText Chr(11)
objSelection.TypeText "555.555.5555 "
objSelection.TypeText "x" & strPhone


Set objSelection = objDoc.Range()

objSignatureEntries.Add "Reply Signature", objSelection

objSignatureObject.ReplyMessageSignature = "Reply Signature"

objDoc.Saved = True
objWord.Quit

Select allOpen in new window