smol84
31-07-2014, 12:23
Есть VBS скрипт который берет данные из АД и формирует подпись
On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strZpov = "С уважением"
strtel = "тел.:"
strmob = "моб.:"
strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strstreet = objuser.streetAddress
strPhone = objUser.telephoneNumber
strMobile = objUser.mobile
strEmail = objuser.mail
strLogo = "\\111\public\temp\111.png"
strsevdol = "\\222\public\temp\222.png"
stryunt = "\\333\public\temp\333.png"
str360 = "\\444\public\temp\444.png"
strgorod = objuser.l
strIPphone = objUser.ipPhone
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 = "Calibri"
objSelection.Font.Size = "11"
objSelection.Font.Color = RGB(99,99,99)
objSelection.Font.Bold = False
'Формат
objSelection.ParagraphFormat.Space1
objSelection.TypeText strRegard
objSelection.TypeText CHR(11)
objSelection.TypeText strZpov & ", " & strName
objSelection.TypeText CHR(11)
objSelection.TypeText strTitle
objSelection.TypeText CHR(11)
objSelection.TypeText strDepartment
objSelection.TypeText CHR(11)
objSelection.InlineShapes.AddPicture(strLogo)
objSelection.TypeText CHR(11)
objSelection.TypeText strgorod & ", " & strstreet
objSelection.TypeText CHR(11)
objSelection.TypeText strtel & strPhone &"(" & strIPphone & ")"
objSelection.TypeText CHR(11)
objSelection.TypeText strmob & objUser.mobile
objSelection.TypeText CHR(11)
objSelection.Hyperlinks.Add objSelection.range, "mailto:" & strEmail, , , strEmail
objSelection.TypeText CHR(11)
'objSelection.InlineShapes.AddPicture(strsevdol)
Set objLink = objSelection.Hyperlinks.Add(objSelection.InlineShapes.AddPicture("\\222\public\temp\222.png"), "http://111.ru/",,,"")
Set objLink = objSelection.Hyperlinks.Add(objSelection.InlineShapes.AddPicture("\\333\public\temp\333.png"), "http://222.ru/",,,"")
Set objLink = objSelection.Hyperlinks.Add(objSelection.InlineShapes.AddPicture("\\444\public\temp\444.png"), "http://333.ru/",,,"")
' ########### Tells outlook to use this signature for new messages and replys. Signature is called AD Signature.
Set objSelection = objDoc.Range()
objSignatureEntries.Add "AD Signature", objSelection
objSignatureObject.NewMessageSignature = "AD Signature"
objSignatureObject.ReplyMessageSignature = "AD Signature"
objDoc.Saved = True
objWord.Quit
Все замечательно, но есть условие поле мобильный заполнено не у всех
Следовательно если оно пустое strMobile = objUser.mobile то нужно сделать так что бы строка в подписи strmob = "моб.:" отсутствовала...
Может кто знает как это сделать
On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strZpov = "С уважением"
strtel = "тел.:"
strmob = "моб.:"
strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strstreet = objuser.streetAddress
strPhone = objUser.telephoneNumber
strMobile = objUser.mobile
strEmail = objuser.mail
strLogo = "\\111\public\temp\111.png"
strsevdol = "\\222\public\temp\222.png"
stryunt = "\\333\public\temp\333.png"
str360 = "\\444\public\temp\444.png"
strgorod = objuser.l
strIPphone = objUser.ipPhone
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 = "Calibri"
objSelection.Font.Size = "11"
objSelection.Font.Color = RGB(99,99,99)
objSelection.Font.Bold = False
'Формат
objSelection.ParagraphFormat.Space1
objSelection.TypeText strRegard
objSelection.TypeText CHR(11)
objSelection.TypeText strZpov & ", " & strName
objSelection.TypeText CHR(11)
objSelection.TypeText strTitle
objSelection.TypeText CHR(11)
objSelection.TypeText strDepartment
objSelection.TypeText CHR(11)
objSelection.InlineShapes.AddPicture(strLogo)
objSelection.TypeText CHR(11)
objSelection.TypeText strgorod & ", " & strstreet
objSelection.TypeText CHR(11)
objSelection.TypeText strtel & strPhone &"(" & strIPphone & ")"
objSelection.TypeText CHR(11)
objSelection.TypeText strmob & objUser.mobile
objSelection.TypeText CHR(11)
objSelection.Hyperlinks.Add objSelection.range, "mailto:" & strEmail, , , strEmail
objSelection.TypeText CHR(11)
'objSelection.InlineShapes.AddPicture(strsevdol)
Set objLink = objSelection.Hyperlinks.Add(objSelection.InlineShapes.AddPicture("\\222\public\temp\222.png"), "http://111.ru/",,,"")
Set objLink = objSelection.Hyperlinks.Add(objSelection.InlineShapes.AddPicture("\\333\public\temp\333.png"), "http://222.ru/",,,"")
Set objLink = objSelection.Hyperlinks.Add(objSelection.InlineShapes.AddPicture("\\444\public\temp\444.png"), "http://333.ru/",,,"")
' ########### Tells outlook to use this signature for new messages and replys. Signature is called AD Signature.
Set objSelection = objDoc.Range()
objSignatureEntries.Add "AD Signature", objSelection
objSignatureObject.NewMessageSignature = "AD Signature"
objSignatureObject.ReplyMessageSignature = "AD Signature"
objDoc.Saved = True
objWord.Quit
Все замечательно, но есть условие поле мобильный заполнено не у всех
Следовательно если оно пустое strMobile = objUser.mobile то нужно сделать так что бы строка в подписи strmob = "моб.:" отсутствовала...
Может кто знает как это сделать