Outlook signature vbs script

Question

Good day.

There is a VBS script for setting up a corporate email to all employees, it is on the internet and easy to find. Recently, this script has become incorrect - the last part of it is -

objSignatureEntries.Add "12345678", objSelection

objSignatureObject.NewMessageSignature = "12345678"

objSignatureObject.ReplyMessageSignature = "12345678"

objDoc.Saved = True

objDoc.Close

objWord.Quit

Only the last line works - objSignatureObject.ReplyMessageSignature = "12345678", if you swap the lines, the other line objSignatureObject.NewMessageSignature = "12345678" also works, but the first line does not work.

When outlook is running, everything works correctly. I think this is due to new updates. How can I solve this problem so that both parameters - ReplyMessageSignature and NewMessageSignature - are set?

Answer 1

WScript.Sleep 100

On Error Resume Next

Set objSysInfo = CreateObject("ADSystemInfo")

strUser = objSysInfo.UserName

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

strRegard = " "

strName = objUser.FullName

strTitle = objUser.Title

strPhone = objUser.telephoneNumber

strMobile = objUser.mobile

strIntPhone = objuser.ipPhone

strPostIndex = ObjUser.postalCode

strCity = objuser.l

strStreet = objuser.streetAddress

strEmail = objuser.mail

strWeb = objuser.wWWHomePage

strLogo = "\\domen.local\NETLOGON\mail\mtech.png"

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

Set objShape1 = objSelection.InlineShapes.AddPicture(strLogo)

objShape1.Width = 175

objShape1.Height = 47

objselection.TypeText Chr(11)

objSelection.Font.Name = "HelveticaNeueCyr"

objSelection.Font.Size = "11"

objSelection.Font.Color = -738164481

objSelection.ParagraphFormat.Space1

objSelection.TypeText strRegard & CHR(11)

objSelection.TypeText strName & CHR(11)

objSelection.Font.Size = "9"

objSelection.Font.Color = RGB(128, 128, 128)

objSelection.TypeText strTitle & CHR(11)

objSelection.TypeText strRegard & CHR(11)

objSelection.Font.Color = RGB(0, 0, 0)

objSelection.TypeText "" & strIntPhone & " доб." & strPhone & CHR(11)

if (strMobile<>"") then objSelection.TypeText "Моб.: " & strMobile & CHR(11)

objSelection.Hyperlinks.Add objSelection.range, "mailto:" & strEmail, , , strEmail

objSelection.TypeText CHR(11)

objSelection.TypeText ""& strPostIndex & ", " & strCity & ", " & strStreet & CHR(11)

objselection.font.color = RGB(0, 0, 255)

objSelection.Hyperlinks.Add objSelection.Range, strWeb, "", "", strWeb

objSelection.TypeText CHR(11)

Set objSelection = objDoc.Range()

objSignatureEntries.Add "Signatury Company", objSelection

objSignatureObject.NewMessageSignature = "Signatury Company"

'objSignatureObject.ReplyMessageSignature = "Signatury Company"

objDoc.Saved = True

objDoc.Close

objWord.Quit

Set curSelection = Nothing

Set objLink = Nothing

Set objWord = Nothing

Set objDoc = Nothing

Set objSelection = Nothing

Set objSignatureObject = Nothing

Set objSignatureEntries = Nothing

WScript.Quit 0

Answer 2

Somebody know how to do that on NEW Outlook

this script not work with