Create a default Outlook signature from AD with vbscript

This site has some great vbscript to create an Outlook signature based on information from Active Directory. It automatically generates a .txt .rtf and .htm signature. To eliminate the extra spacing, add this to the script after
Set objSelection = objWord.Selection

objSelection.Style = "No Spacing"

This is great if you want to force your users to have standardize Outlook signatures and to add a disclaimer / confidentiality notice.

UPDATE:
This works great for Outlook 2007 clients, but in Outlook 2003 I get double spaced signatures. I can't figure out a way around this without using registry entries to switch to .txt or .rtf signatures. Outlook 2003 doesn't know what "No Spacing" is. Looking at the generated html, there's a no spacing class p class=MsoNoSpacing created by the Outlook 2007 clients. The Outlook 2003 clients also don't know about that class. I need to stop it from using html paragraph tags for each line.

UPDATE2:

I finally have a script that works both with Office 2003 and 2007. objSelection.Style = "No Spacing" takes care of 2007, but for 2003 you need to use Chr(11) instead of vbNewline.

Here's my final script:

On Error Resume Next

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

strConfid = "Confidentiality Notice: blah blah blah"
strFname = objUser.FirstName
strLname = objUser.LastName
strInitial = objUser.Initials
strTitle = objUser.Title
strDepartment = objUser.Department
strCompany = objUser.Company 
strPhone = objUser.telephoneNumber
strFax = objUser.faxnumber



Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then
Set objWord = CreateObject("Word.Application")
blnWeOpenedWord = True
End If
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObjects = objWord.EmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObjects.EmailSignatureEntries
objSelection.Style = "No Spacing"

'Name
objselection.Font.Bold = true
objSelection.TypeText UCase(strFname) & " "
if strInitial then objSelection.TypeText UCase(strInitial) & ". "
objSelection.TypeText UCase(strLname)
if strTitle then objSelection.TypeText ", " & strTitle
objSelection.TypeText Chr(11)
objselection.Font.Bold = false


if strDepartment then objSelection.TypeText strDepartment & Chr(11) 
objSelection.TypeText Chr(11)
objSelection.TypeText strCompany & Chr(11)
objSelection.TypeText strStreet & Chr(11)
objSelection.TypeText strCSZ & Chr(11)
objSelection.TypeText "Phone: " & strPhone & Chr(11)
objSelection.TypeText "Fax: " & strFax & Chr(11)
objSelection.TypeText strToll & Chr(11) & Chr(11)


objSelection.TypeText strConfid
Set objSelection = objDoc.Range()

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

objDoc.Close 0
If blnWeOpenedWord Then
objWord.Quit
End If