Comment vérifier les adresses des destinataires avant d’envoyer un e-mail dans Outlook ?

Il arrive parfois d’oublier d’ajouter certains destinataires importants dans les champs À, Cc ou Cci lors de l’envoi d’e-mails via Outlook. Découvrez ici une méthode simple pour vérifier que les adresses e-mail spécifiques ont bien été incluses avant l’envoi.

Vérifier les adresses avant l’envoi à l’aide d’un code VBA

---

Vérifier les adresses avant l’envoi à l’aide d’un code VBA

Je vous propose ici deux codes pour vous aider à accomplir cette tâche ; choisissez celui qui correspond le mieux à vos besoins.

1. Appuyez sur Alt + F11 pour ouvrir la fenêtre Microsoft Visual Basic pour Applications.

2. Double-cliquez sur ThisOutlookSession dans le volet Projet1 pour ouvrir l’éditeur de code, puis copiez-collez le code ci-dessous dans l’éditeur.

VBA : vérifier l’adresse du destinataire dans le champ À avant l’envoi

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'UpdatebyExtendoffice20180523
Dim xAddressArr() As Variant
Dim xAddress As String
Dim xRecipient As Recipient
Dim xPrompt As String
Dim xYesNo As Integer
Dim xDictionary As Scripting.Dictionary
On Error Resume Next
Set xDictionary = New Scripting.Dictionary
xAddressArr = Array("example1@126.com", "example2@126.com", "example3@126.com")
For i = LBound(xAddressArr) To UBound(xAddressArr)
    xDictionary.Add xAddressArr(i), True
Next i
For Each xRecipient In Item.Recipients
    If xRecipient.Type = olTo Then
        If xDictionary.Exists(xRecipient.Address) Then xDictionary.Remove xRecipient.Address
    End If
Next
If xDictionary.Count = 0 Then GoTo L1
For i = 0 To xDictionary.Count - 1
    If xAddress = "" Then
        xAddress = xDictionary.Keys(i)
    Else
        xAddress = xAddress + "; " & xDictionary.Keys(i)
    End If
Next i
xPrompt = "You are not sending this to: " & xAddress & ". Are you sure you want to send the Mail?"
xYesNo = MsgBox(xPrompt, vbQuestion + vbYesNo, "Kutools for Outlook")
If xYesNo = vbNo Then Cancel = True
L1:
  Set xRecipient = Nothing
  Set xDictionary = Nothing
End Sub

Dans ce code, remplacez simplement («example1@126.com», «example2@126.com», «example3@126.com») par les adresses e-mail réelles de vos destinataires.

3. Toujours dans la fenêtre Microsoft Visual Basic pour Applications, cliquez sur Outils > Références. Cochez la case Microsoft Scripting Runtime dans la boîte de dialogue Références - Projet1.

4. Cliquez sur OK et enregistrez le code.

Désormais, si les destinataires spécifiés ne figurent pas dans le champ « À » lors de l’envoi d’un e-mail, une boîte de dialogue s’affiche pour vous demander si vous souhaitez tout de même envoyer le message.

Avec le code précédent, seule l’adresse présente dans le champ À est vérifiée. Si vous souhaitez effectuer cette vérification dans les champs À, Cc et Cci, vous pouvez utiliser le code ci-dessous.

VBA : vérifier l’adresse du destinataire dans les champs À/Cc/Cci avant l’envoi

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'UpdatebyExtendoffice20180523
Dim xRecipients As Outlook.Recipients
Dim xRecipient As Outlook.Recipient
Dim xPos As Integer
Dim xYesNo As Integer
Dim xPrompt As String
Dim xAddress As String
On Error Resume Next
If Item.Class <> olMail Then Exit Sub
Set xRecipients = Item.Recipients
xAddress = "example1@gmail.com"
For Each xRecipient In xRecipients
    xPos = InStr(LCase(xRecipient.Address), xAddress)
    If xPos = 0 Then
        xPrompt = "You sending this to " & xAddress & ". Are you sure you want to send it?"
        xYesNo = MsgBox(xPrompt, vbYesNo + vbQuestion + 4096, "Kutools for Outlook")
        If xYesNo = vbNo Then Cancel = True
    End If
Next xRecipient
End Sub

Grâce à ce code, inutile de cocher la case Microsoft Scripting Runtime : enregistrez-le directement pour qu’il prenne effet immédiatement.