Войти

Показать полную графическую версию : Создание подписи Outlook через VBS с условием


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 = "моб.:" отсутствовала...
Может кто знает как это сделать

Iska
31-07-2014, 14:57
С «On Error Resume Next» никогда не бывает «замечательно». Где у Вас определяется «strRegard», что за «objDoc.Range()»?

Общий принцип:
If Not IsEmpty(objIADsUser.mobile) Then
.TypeText "моб.:" & objIADsUser.mobile
.TypeText CHR(11)
End If

smol84
04-08-2014, 15:20
Сделал вот так

If objUser.mobile <> "" Then
objSelection.TypeText CHR(11)
objSelection.TypeText strmob & objUser.mobile
End If




© OSzone.net 2001-2012