UPD: Благодарю за ознакомление с правилами.

Пока оформление не будет приведено в порядок, ответы будут удаляться. Если в течение 3 суток тема не будет оформлена должным образом, то будет удалена.

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

strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
'Логотип организации
strLogo = "http://192.168.2.19/smart.gif"
strRegard = "С уважением, "
'Получаем полное имя
strName = objUser.FullName
'Должность
strTitle = objUser.Title
'Подразделение
strDepartment = objUser.Department
'Компания
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 = objuser.wWWHomePage
mine = "---------------------"

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.InlineShapes.AddPicture(strLogo)
objSelection.TypeText CHR(11)
'Задаем настройки шрифта
'Шрифт
objSelection.Font.Name = "Arial"
'Размер
objSelection.Font.Size = "10"
'Цвет, можно указывать в десятичном или RGB формате, тогда: RGB(0, 55, 110)
objSelection.Font.Color = -738164481
'Формат
objSelection.ParagraphFormat.Space1
objSelection.TypeText CHR(11)
objSelection.TypeText strRegard & CHR(11)
objSelection.TypeText CHR(11)
'Вставляем полное имя
objSelection.TypeText strName & CHR(11)
'Должность
objSelection.TypeText strTitle & CHR(11)
'Тирэ
objSelection.TypeText "----------------------------------------" & CHR(11)
objSelection.Font.Size = "9"
objSelection.TypeText "Компания 'СМАРТ'" & CHR(11)
'Подразделение
'if (strDepartment<>"") then objSelection.TypeText strDepartment & CHR(11)
'Компанию
'objSelection.TypeText strCompan & "ООО 'Чмарт' " &  CHR(11)
'Уменьшаем размер шрифта

'Почтовый адрес
objSelection.TypeText strPostIndex & "19999 Москва, Павелецкая набережная д. 2, оф. 310,  БЦ «River Side»."
objSelection.TypeText CHR(11) 
'Телефон
objSelection.TypeText "Тел.: +7(495)980-90-66, доб " & strPhone & CHR(11)
'Сотовый
if (strMobile<>"") then objSelection.TypeText "Моб. тел.:" & strMobile & CHR(11)
'ICQ
'if (strIntPhone<>"") then objSelection.TypeText "ICQ " & strIntPhone & CHR(11)
'Факс
'objSelection.TypeText "Факс " & strFax & CHR(11)

'Изменяем цвет для адреса электронной почты и сайта

'Вставляем адрес почты
objSelection.TypeText "E-mail: "
objselection.font.color = RGB(0, 0, 255)
objSelection.Hyperlinks.Add objSelection.Range, "mailto:" & strEmail, , , strEmail
objSelection.TypeText CHR(11)

'корпоративный сайт
objselection.font.color = -738164481
objSelection.TypeText "Web: "
objselection.font.color = RGB(0, 0, 255)
objSelection.Hyperlinks.Add objSelection.Range, "www.smartactive.ru"
objSelection.TypeText CHR(11)


Set objSelection = objDoc.Range()

objSignatureEntries.Add "Smart", objSelection
objSignatureObject.NewMessageSignature = "mart"
objSignatureObject.ReplyMessageSignature = "mart"

objDoc.Saved = True
objDoc.Close
objWord.Quit