Подпись outlook для всех учетных записей пользователй
 

Здравствуйте, есть скрипт, который добавляет подпись к сообщениям в outlook (новым и пересылаемым).
Есть одна проблема, этот скрипт меняет настройки только к учетной записи , которая по умолчанию. Если в Outlook больше одной учетной записи, то к другим подпись не применяется.
как установить для всех учетных записей.
Спасибо.

Вот скрипт
On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strZpov = "С уважением,"
strPostIndex = ObjUser.postalCode
strName = objUser.FullName
strTitle = objUser.Title
strDepartment = objUser.Department
strCompany = objUser.Company
strPhone = objUser.telephoneNumber
strweb = objuser.wWWHomePage
strgorod = objuser.l
strstreet = objuser.streetAddress
strfax = objuser.facsimileTelephoneNumber
strIntPhone = objuser.ipPhone
strEmail = objuser.mail
strMobile = objUser.mobile
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.ParagraphFormat.Space1
objselection.font.color = RGB(0, 0, 0)
objSelection.TypeText strZpov
objSelection.TypeText CHR(11)
objSelection.TypeText strName
objSelection.TypeText CHR(11)
objSelection.TypeText strTitle
objSelection.TypeText CHR(11)
objSelection.TypeText strDepartment
objSelection.TypeText CHR(11)
objSelection.TypeText "Филиал ПАО ФСК ЕЭС - " & strCompany
objSelection.TypeText CHR(11)
objSelection.TypeText "Тел.: " & strPhone
If objUser.mobile <> "" Then
objSelection.TypeText CHR(11)
objSelection.TypeText "Моб.: " & strMobile
End If
objSelection.TypeText CHR(11)
objSelection.TypeText "Почта: "
objselection.font.color = RGB(0, 0, 255)
objSelection.Hyperlinks.Add objSelection.range, "mailto:" & strEmail, , , strEmail
objSelection.TypeText CHR(11)
objSelection.Hyperlinks.Add objSelection.Range, strWeb, "", "", strWeb
objSelection.TypeText CHR(11)
objselection.font.color = RGB(0, 0, 0)
objSelection.TypeText strPostIndex & ", " & strgorod & " ул. " & strstreet
Set objSelection = objDoc.Range()
objSignatureEntries.Add "AD Signature", objSelection
objSignatureObject.NewMessageSignature = "AD Signature"
objSignatureObject.ReplyMessageSignature = "AD Signature"
objDoc.Saved = True
objDoc.Close()
objWord.Quit()