Que celui qui n’a jamais fait « REPONDRE A TOUS » au lieu de « REPONDRE » sur OUTLOOK me jette la première pierre.
(fonctionne sur Outlook 2010 et 2016 - pour les autres versions, merci de tester et remonter l'info)
Pour éviter cela, je vous propose le code ci-dessous qui proposera un message de confirmation avant d’envoyer le mail.
La manip réside dans le fait que les adresses mails sont séparées par un point-virgule pour chacun des types de correspondants « A » , « CC » et « CCC ».
Vous l’aurez compris, il suffira d’additionner ces points-virgules et les types de destinataires qui, s'il est supérieur à 1, déclenchera le message.
Pour mettre ce code en place, dans OUTLOOK, ALT+F11, Insérer un Module et Copier/Coller le code ci-dessous.
Curt
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) On Error Resume Next Dim Destinataire_A() As String 'A: Dim Destinataire_CC() As String 'CC: Dim Destinataire_BCC() As String 'CCC: Dim NbreDestinataire_A As Integer 'A: Dim NbreDestinataire_CC As Integer 'CC: Dim NbreDestinataire_BCC As Integer 'CCC: Dim NbreDestinataire As Integer 'Nombre total de destinataires 'ALERTE SI PLUSIEURS DESTINATAIRES (Eviter le "Répondre à tous" par erreur) Destinataire_A = Split(mail.To, ";") NbreDestinataire_A = UBound(Destinataire_A()) + 1 'Si aucun A: on a -1 donc on doit ajouter 1 pour avoir 0 Destinataire_CC = Split(mail.CC, ";") NbreDestinataire_CC = UBound(Destinataire_CC()) + 1 'Si aucun CC: on a -1 donc on doit ajouter 1 pour avoir 0 Destinataire_BCC = Split(mail.BCC, ";") NbreDestinataire_BCC = UBound(Destinataire_BCC()) + 1 'Si aucun CCC: on a -1 donc on doit ajouter 1 pour avoir 0 NbreDestinataire = NbreDestinataire_A + NbreDestinataire_CC + NbreDestinataire_BCC If NbreDestinataire > 1 Then If MsgBox("Attention ! Envoi du courrier à plusieurs destinataires.", _ vbCritical + vbYesNo, "Attention !") = vbNo Then Cancel = True End If End If End Sub
Partager