VBA -> Outlook 2003 -> Получение SMTP-адреса с использованием CDO -> WARNING

Формулировка задачи:

Наваял такую функцию:

TestCDO()
    PR_SMTP_ADDRESS = &H39FE001E
    PR_EMS_AB_PROXY_ADDRESSES = &H800F101E

   olMail  
   objSession  MAPI.Session
   objMessage  MAPI.Message
   objField  MAPI.Field
   FlagVal  
   FVal  Variant
  
   objSession = CreateObject()
  objSession.Logon , , False, False, 
  
    olMail  Application.ActiveExplorer.Selection
     LCase(TypeName(olMail)) =  
       objMessage = objSession.GetMessage(olMail.EntryID)
      Debug. (objMessage.Subject)

      FlagVal = 
       LCase(objMessage.Sender.) =  
        FlagVal = objMessage.Sender.Address
      
          objField  objMessage.Sender.Fields
           (objField.ID = PR_SMTP_ADDRESS)  (FlagVal = )  FlagVal = objField.Value
           (objField.ID = PR_EMS_AB_PROXY_ADDRESSES)  (FlagVal = ) 
              FVal  objField.Value
               InStr(, LCase(FVal), ) >   FlagVal = Right(FVal, Len(FVal) - InStr(, LCase(FVal), ) - )

      Debug. (FlagVal)

 

Всё замечательно работает, но при обращении к объекту Sender возникает сообщение: "Программа пытается получить доступ к адресам электронной почты, хранящимся в Outlook. Разрешить это действие?". И такое повторяется каждый раз при запуске функции. Как предотвратить появление этого сообщения? Проект VBA подписан цифровой подписью, все требования безопасности соблюдены.. Что где подкрутить/прижечь?

Решение задачи: «VBA -> Outlook 2003 -> Получение SMTP-адреса с использованием CDO -> WARNING»

textual
                            Листинг программы 
                        

                            <font color="blue">Private</font> <font color="blue">Sub</font> TestRDO()
  <font color="blue">Const</font> PR_SMTP_ADDRESS = &H39FE001E
  <font color="blue">Const</font> PR_EMS_AB_PROXY_ADDRESSES = &H800F101E
  <font color="blue">Dim</font> olMail <font color="blue">As</font> <font color="blue">Object</font>
  <font color="blue">Dim</font> objSession <font color="blue">As</font> RDOSession
  <font color="blue">Dim</font> objMessage <font color="blue">As</font> RDOMail
  <font color="blue">Dim</font> FlagVal <font color="blue">As</font> <font color="blue">String</font>
  
  <font color="blue">Set</font> objSession = CreateObject(<font color="teal">"Redemption.RDOSession"</font>)
  objSession.MAPIOBJECT = Application.Session.MAPIOBJECT

  <font color="blue">For</font> <font color="blue">Each</font> olMail <font color="blue">In</font> Application.ActiveExplorer.Selection
    <font color="blue">If</font> LCase(TypeName(olMail)) = <font color="teal">"mailitem"</font> <font color="blue">Then</font>
      <font color="blue">Set</font> objMessage = objSession.GetMessageFromID(olMail.EntryID)
      Debug.<font color="blue">Print</font> (objMessage.Subject)

      FlagVal = <font color="teal">""</font>
      <font color="blue">If</font> LCase(objMessage.Sender.<font color="blue">Type</font>) = <font color="teal">"smtp"</font> <font color="blue">Then</font>
        FlagVal = objMessage.Sender.Address
      <font color="blue">Else</font>
        FlagVal = objMessage.Sender.Fields(PR_SMTP_ADDRESS)
        <font color="blue">If</font> FlagVal = <font color="teal">""</font> <font color="blue">Then</font> FlagVal = objMessage.Sender.Fields(PR_EMS_AB_PROXY_ADDRESSES)
      <font color="blue">End</font> <font color="blue">If</font>
      Debug.<font color="blue">Print</font> (FlagVal)
    <font color="blue">End</font> <font color="blue">If</font>
  <font color="blue">Next</font>
<font color="blue">End</font> <font color="blue">Sub</font>

                        