Скрипт, формирующий подпись сотрудникам на основании атрибутов Active Directory. Тестировался на Outlook 2003/2007.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 |
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 |