Désactiver l'avertissement de sécurité Outlook lors de l'exécution d'un code VBA Excel

Question

Mon but ultime est de donner des informations sur les contacts dans Outlook ou MS Exchange et d'obtenir leur nom et adresse e-mail sans rencontrer de message d'avertissement.

J'ai développé une fonction qui fonctionne bien à l'exception de la partie où je reçois un message d'avertissement pop-up de Outlook Object Model Guard (OMG) et je dois contourner sans utiliser aucun complément payé, CDP, Redemption ou modifier le paramètre dans Accès par programme dans l'application Outlook (Trust Center) etc.

Mon code est dans VBA Excel et je ne fais pas de liaison anticipée à la bibliothèque Outlook.

Je sais que l'accès à certains objets ou méthodes déclenchera l'avertissement OMG et attendra une confirmation de la part de l'utilisateur. Je me demandais il ya un moyen de pro grammaticalement dans VBA désactiver OMG et ensuite l'activer après?

Excel VBA Fonction:

Public Function GetContactObject2(strInput As String) As Object 
    Dim chk As Boolean 
    Dim sEmailAddress As String 
    Dim olApp As Object 
    Dim olNS As Object 'NameSpcase OL identifiers 
    Dim olAL As Object 'AddressList An OL address list 
    Dim olRecip As Object 'Outlook Recipient Object 
    Dim olAddrEntry As Object 'AdressEntry An Address List entry 
    Dim olCont As Object 'ContactItem An Outlook contact item 
    Dim olExchUser As Object 'outlook Exchange User Object 
    Dim obj As Object 
    Dim oPA As Object 

    chk = True 'assume everything is running fine 
    Err.Clear 

    'On Error GoTo Handler 
    Set olApp = GetObject(, "Outlook.Application") 

    'If an instance of an existing Outlook object is not available, an error will occur (Err.Number = 0 means no error): 
    If Err.Number <> 0 Then 
     Set olApp = CreateObject("Outlook.Application") 
    End If 

    Set olNS = olApp.GetNamespace("MAPI") 
    'Set olAL = olNS.AddressLists("Global Address List") 
    Set olRecip = olNS.createrecipient(strInput) 
    olRecip.Resolve 'this line will cause Outlook Security Manager to pop up a message to allow or deny access to email 

    'Check if the entry was resolved 
    If olRecip.Resolved Then 
     Set olAddrEntry = olRecip.AddressEntry 
     Set olCont = olAddrEntry.GetContact 

     If Not (olCont Is Nothing) Then 
      'this is a contact 
      'olCont is ContactItem object 
      MsgBox olCont.FullName 
     Else 
      Set olExchUser = olAddrEntry.GetExchangeUser 
      If Not (olExchUser Is Nothing) Then 
       'olExchUser is ExchangeUser object 
       'MsgBox olExchUser.PrimarySmtpAddress 
       Set obj = olExchUser 
      Else 
       Set obj = Nothing 
      End If 
     End If 
    Else 'Recipient was not found at all in the Global Address List 
     Set obj = Nothing 
    End If 
    On Error GoTo 0 

    Set GetContactObject2 = obj 
    Exit Function 
Handler: 
    MsgBox "Err #: " & Err.Number & vbNewLine & Err.Description 
End Function 

Excel VBA Fonction 2 qui appelle la première fonction:

'========================================= 
    ' Get Current User Email Address Function 
    '========================================= 
    ' Gets current user's email address using outlook MAPI namespace 
    ' RETURNS: user email if found, otherwise a zero-length string 
    Public Function GetCurrentUserEmailAddress2() As String 
     Dim chk As Boolean 
     Dim strInput As String 'any string that can be resolved by outlook to retrieve contact item 
     Dim sEmailAddress As String 
     Dim olApp As Object 
     Dim olNS As Object 
     Dim obj As Object 'object for contact 

     chk = True 'assume everything is running fine 
     Err.Clear 

     On Error Resume Next 
     Set olApp = GetObject(, "Outlook.Application") 

     'if an instance of an existing Outlook object is not available, an error will occur (Err.Number = 0 means no error): 
     If Err.Number <> 0 Then 
      Set olApp = CreateObject("Outlook.Application") 
     End If 


     '''' Set olNS = olApp.GetNamespace("MAPI") 
     'This line will cause Outlook to pop a warning window that a program wants to have access your email address 
     '''' sEmailAddress = olNS.Accounts.Item(1).SmtpAddress 


     'Get a contact object and then extract the email from there 
     'NOTE: some users' alias is their windows login, but some have different alias so it may fail. The best bet is finding the 
     'email address using some other way and using it as the input which will almost never fail 


     strInput = olApp.Session.CurrentUser.Address 
     Set obj = GetContactObject2(strInput) 

     If obj Is Nothing Then 
      'Try one more time with windows login 
      strInput = Environ("UserName") 
      Set obj = GetContactObject2(strInput) 
      If obj Is Nothing Then 
       chk = False 
      Else 
       sEmailAddress = obj.PrimarySmtpAddress 
      End If 
     Else 
      sEmailAddress = obj.PrimarySmtpAddress 
     End If 

     'Return a zero length string if by any chance email could not be retrieved, else validate it 
     If chk = True Then 
      chk = ValidateEmailAddress(sEmailAddress, bShowMessage:=False) 
     Else 
      sEmailAddress = "" 
     End If 

     On Error GoTo 0 

     'Assign string to function 
     GetCurrentUserEmailAddress2 = sEmailAddress 

    End Function 

Answer 1

Si vous n'avez besoin que de l'adresse e-mail de l'utilisateur actuel, j'utiliserais Active Directory. Tous vos utilisateurs devraient être capables de lire au moins les valeurs de AD. Voir this post pour savoir comment interroger AD en code VBA.

Remarque: le nom de l'attribut email est mail, documentation. Donc, vous devez modifier le code dans le lien vers attr = "mail" et WScript.Echo rs.Fields("mail").Value

Side note: Je vous suggère fortement tout développeur installer RSAT afin qu'ils puissent vérifier les valeurs dans AD en utilisant MMC.

Answer 2

Vous devez soit vous assurer un Up- application AV à jour est installé, ou (si vous ne pouvez pas contrôler l'environnement ment), un utilitaire comme ClickYes pour simuler un clic de souris sur l'invite de sécurité ou un léchage de bibliothèque pour contourner l'invite par programmation.

Voir http://www.outlookcode.com/article.aspx?id=52 pour la liste détaillée de vos options.