Скрипт, формирующий подпись сотрудникам на основании атрибутов Active Directory.

Скрипт, формирующий подпись сотрудникам на основании атрибутов Active Directory. Тестировался на Outlook 2003/2007.

On Error Resume Next

Set objSysInfo = CreateObject("ADSystemInfo")

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

strZpov = "С уважением, "
strDev =

"---------------------------------------------------------------------------------------

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

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

-----------------------------"
strPostIndex = ObjUser.postalCode
strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strCompany = objUser.Company
strPhone = objUser.telephoneNumber
strMob= objUser.Mobile
strweb = "www.domain.com"
strgorod = objuser.l
strstreet = objuser.streetAddress
strfax = objuser.facsimileTelephoneNumber
strIntPhone = objuser.ipPhone
strEmail = objuser.mail
strLogo = "\\servername\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 = "Garamond"
objSelection.TypeText CHR(11)
objSelection.InlineShapes.AddPicture(strLogo)
objSelection.TypeText CHR(11)
objSelection.TypeText CHR(11)
objSelection.TypeText strZpov
objSelection.TypeText strName
objSelection.TypeText CHR(11)
objSelection.TypeText strTitle
objSelection.TypeText CHR(11)
objSelection.TypeText strCompany
objSelection.TypeText CHR(11)
objSelection.TypeText CHR(11)
objSelection.TypeText "тел: " & strPhone
objSelection.TypeText CHR(11)
objSelection.TypeText "моб: " & strMob
objSelection.TypeText CHR(11)
objSelection.TypeText "факс: " & strfax
objSelection.TypeText CHR(11)
objSelection.TypeText "Email: " & strEmail
objSelection.TypeText CHR(11)
objSelection.Hyperlinks.Add objSelection.Range, strWeb, "", "", strWeb

Set objSelection = objDoc.Range()

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

objDoc.Saved = True

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *