Outlook + AD. Автоматическое создание/добавление подписей

Самый популярный вариант подписи - смотрел сначала на alexxhost.ru
Но у этого варианта есть огромный минус - подпись нельзя подставить в конец своего сообщения, ну не умеет этого exchange в базе.
Есть софт от сторонних разработчиков. Но за бабло.

Пример. Взято с kvazar.wordpress.com
--------------------------

On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")

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

strRegard = "С уважением,"
'Получаем полное имя
strName = objUser.FullName
'Должность
strTitle = objUser.Title
'Подразделение
strDepartment = objUser.Department
'Компания
strCompany = "ООО Рожки да Ножки"
'strCompany = objUser.Company
'Номер телефона
strPhone = objUser.telephoneNumber
'Сотовый
strMobile = objUser.mobile
'Факс
strFax = objuser.facsimileTelephoneNumber
'IP-телефон, у себя не использую, так как внутренний номер дописываю в поле основного телефона
'strIntPhone = objuser.ipPhone
'Получаем почтовый индекс
strPostIndex = ObjUser.postalCode
'Город
'strCity = objuser.l
'Улица
'strStreet = objuser.streetAddress
'адрес электронной почты
strEmail = objuser.mail
'WEB страница
strWeb = "http://www.rojki-da-nojki.ru"
'Логотип организации
strLogo = "\\rojki.nojki\NETLOGON\logo.gif"

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"
'Цвет, можно указывать в десятичном или RGB формате, тогда: RGB(0, 55, 110)
objSelection.Font.Color = -738164481
'Формат
objSelection.ParagraphFormat.Space1

objSelection.TypeText strRegard
objSelection.TypeText CHR(11)
'Вставляем полное имя
'''objSelection.TypeText strName
'''objSelection.TypeText CHR(11)
'Должность
objSelection.TypeText strTitle
objSelection.TypeText CHR(11)
'Подразделение
'objSelection.TypeText strDepartment
'objSelection.TypeText CHR(11)
'Компанию
objSelection.TypeText strCompany
objSelection.TypeText CHR(11)
'Вставляем полное имя
objSelection.TypeText strName
objSelection.TypeText CHR(11)
'Уменьшаем размер шрифта для адреса
objSelection.Font.Size = "9"
'Почтовый адрес
'objSelection.TypeText strPostIndex & ", г. " & strCity & ", " & strStreet
'objSelection.TypeText CHR(11)
'Телефон
'objSelection.TypeText "Тел. " & strPhone ' доб. & strIntPhone
objSelection.TypeText "Тел. +7(000)123-45-67 " & strPhone ' доб. & strIntPhone
objSelection.TypeText CHR(11)
'Сотовый
'objSelection.TypeText "Моб. " & strMobile
objSelection.TypeText "" & strMobile
objSelection.TypeText CHR(11)
'Факс
'objSelection.TypeText "Факс " & strFax
'objSelection.TypeText CHR(11)
'Изменяем цвет для адреса электронной почты и сайта
objselection.font.color = RGB(0, 0, 255)
'корпоративный сайт
objSelection.Hyperlinks.Add objSelection.Range, strWeb, "", "", strWeb
objSelection.TypeText CHR(11)
'Вставляем адрес почты
objSelection.Hyperlinks.Add objSelection.range, "mailto:" & strEmail, , , strEmail
objSelection.TypeText CHR(11)

'логотип компании
objSelection.InlineShapes.AddPicture(strLogo)

Set objSelection = objDoc.Range()

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

objDoc.Saved = True
objDoc.Close
objWord.Quit

--------------------------