Remplir le champ CC automatiquement sous Outlook [À faire]

**Labore** · 25/06/2007, 15h52

Bonjour,

Je n'ai que peu de compétence en développement, et j'aimerais une macro sous Outlook qui me remplisse automatiquement le champ CC à chaque fois que j'envoie un nouveau mail ou que je réponds à un mail.
En effet, je dois toujours envoyer copie de mes mails à la même personne, et cela me simplifierait un peu

la tâche si cela se remplissait sans que je n'ai rien à faire.
Merci d'avance pour toute piste de solution.

Labore

**Heureux-oli** · 25/06/2007, 23h07

Bonjour et bienvenue sur les forums Office de DVP.

Ce bout de code devrait te le faire.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Item.CC = "Monadresse@fai.fr"
 
End Sub

**Labore** · 26/06/2007, 00h59

Merci beaucoup de la réponse,
malheureusement, cela marche mal. J'ai plusieurs compte mail sous Outlook 2003, et la macro modifie l'expéditeur retenu sans envoyer la copie, alors même qu'elle apparaît dans les champs du message envoyé. Là, je suis très perplexe sur le fonctionnement de Outlook

.
Encore merci, et je continue à tester et chercher.
Labore

**Heureux-oli** · 26/06/2007, 08h16

Je rencontre le même problème, je vais chercher le motif.

**Labore** · 26/06/2007, 10h15

J'ai essayé cela, mais pareil, cela ne marche pas, il me change l'affichage de l'expéditeur dans la boite d'expédition (mais il reste cependant celui que j'utilise) et le destinataire en copie n'est que du texte, pas une adresse mail... dur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 
Dim monMail As MailItem
Dim monDest As Recipient
 
Set monMail = Outlook.Application.ActiveInspector.CurrentItem
Set monDest = monMail.Recipients.Add("destinataire@copie.fr")
 
monDest.Type = olCC
 
 
End Sub

**Oliv-** · 29/06/2007, 12h34

Salut,
J'avais fait pareil et en plus publié le code

Regarde ici je viens de le corriger et ca doit marcher !

Cette macro vient en fait remplacer le précédente qui ne fonctionnait pas correctement. ;-(((
Item.BCC =CCI ajoutait bien le CCI mais sans lui envoyer la copie !!

A mettre dans thisOutlookSession

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Private Sub Application_ItemSend(ByVal Item As Object, _
 
Cancel As Boolean)
 
'By Oliv' 29/06/2007 pour Outlook 2003
 
Dim myRecipient As Outlook.Recipient
 
If Not Item.Class = olMail Then GoTo fin
 
Dim prompt As String
 
' ici renseigner le destinataire
 
cci = "MonDestinataire@sonDomaine.fr"
 
'commentez au choix l'option non voulue
 
'########################Option CCI############################
 
prompt = "Ajouter le cci " & cci & " à " & Item.Subject & "?"
 
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbYes Then
 
Set myRecipient = Item.Recipients.Add(cci)
 
myRecipient.Type = olBCC
 
myRecipient.Resolve
 
If myRecipient.Resolved = False Then
 
MsgBox "L'adresse Email n'est pas correcte !", vbCritical, "Erreur"
 
Cancel = True
End If
 
End If
 
'########################Option CC##############################
 
prompt = "Ajouter le cc " & cci & " à " & Item.Subject & "?"
 
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbYes Then
 
Set myRecipient = Item.Recipients.Add(cci)
 
myRecipient.Type = olCC
 
myRecipient.Resolve
 
If myRecipient.Resolved = False Then
 
MsgBox "L'adresse Email n'est pas correcte !", vbCritical, "Erreur"
 
Cancel = True
End If
 
End If
 
'#######################FIN#####################################
 
fin:
 
End Sub

Oliv'

**Labore** · 30/06/2007, 17h36

Salut Oliv'

Alors là, tu m'épates. Tout marche à merveille

Je n'ai pas vu que tu avais déjà publié ce code... et je ne vois pas ce qui fait que le tiens marche et pas ceux qui précèdent

Mystères de l'informatique ?

Encore un très très grand merci,

Labore

**vynmarius** · 09/06/2015, 11h33

bonjour,

je suis tombé sur ce post, et m'en suis inspiré pour faire une macro pour Outlook 2013. Comme les réponses sont parfois plus importantes que les messages reçus, je m'envoie automatiquement tous messages que j'envoie Comme j'archive parfois les réponses étaient perdu dans le temps ... . merci au développeur d'origine (Oliv')

c'est un beau déterrage de post quand même 2007 ...

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 
'By Oliv' 29/06/2007 pour Outlook 2003, modifié pour Outlook 2013 (Vynmarius) 2015/06/09
 
Dim myRecipient As Outlook.Recipient
 
If Not Item.Class = olMail Then GoTo fin
 
Dim prompt As String
 
 
' ici renseigner le destinataire CCI automatique
cci = "moi@monmail.com"
Set myRecipient = Item.Recipients.Add(cci) 'ajout automatique au champ cci
myRecipient.Type = olBCC
myRecipient.Resolve
If myRecipient.Resolved = False Then
MsgBox "L'adresse Email n'est pas correcte !", vbCritical, "Erreur"
Cancel = True
End If
 
' ici renseigner le destinataire CC/CCI conditionnel
cci2 = "monboss@sonmail.com"
 
'commentez / dé-commentez au choix l'option voulue / non voulue
 
'########################Option CCI############################
 
prompt = "Ajouter le cci " & cci2 & " à " & Item.Subject & "?"
 
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbYes Then
 
Set myRecipient = Item.Recipients.Add(cci2) ' ajout au champ cci, sous condition
 
myRecipient.Type = olBCC
 
myRecipient.Resolve
 
If myRecipient.Resolved = False Then
 
MsgBox "L'adresse Email n'est pas correcte !", vbCritical, "Erreur"
 
Cancel = True
End If
 
End If
 
'########################Option CC##############################
 
'prompt = "Ajouter le cc " & cci2 & " à " & Item.Subject & "?"
 
'If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbYes Then
 
'Set myRecipient = Item.Recipients.Add(cci2) ' ajout au champ cc, sous condition
 
 
'myRecipient.Type = olCC
 
'myRecipient.Resolve
 
'If myRecipient.Resolved = False Then
 
'MsgBox "L'adresse Email n'est pas correcte !", vbCritical, "Erreur"
 
'Cancel = True
'End If
 
'End If
 
'#######################FIN#####################################
 
fin:
 
End Sub

**raf452** · 15/07/2015, 15h04

Bonjour,

J'utilise votre code qui fonctionne très bien. Je voudrais ajouter à la boite de dialogue un bouton annuler. J'ai donc ce code maintenant:

If MsgBox(prompt, vbYesNoCancel + vbQuestion, "Sample") = vbYes Then

Sauf que quand je clic sur annuler cela envoi quand même le mail et la CCi avec.

Je voudrais qu'en cliquant sur annuler, cela ferme la boite de dialogue, et me laisse sur le message pour le modifier si j'ai besoin.

Merci de vos réponses

**vynmarius** · 15/07/2015, 15h43

Salut,
le problème vient du type 'Application_ItemSend', qui agit au moment de l'envoi, et donc je ne pense pas que l'on puisse l'annuler. après je ne fais que m'inspirer de code, je ne maitrise pas VBA comme certains ici, je fais du bricolage ^^' . attend de voir si quelqu'un peut t'aider.

**raf452** · 15/07/2015, 15h52

Merci pour la réponse.

En fouillant et en faisant des essais j'ai réussit à utiliser la fonction annule. Par contre maintenant si j'annule je reste sur le message et peux continuer a le modifier mais si je confirme l'ajout du CCi la boite de dialogue s'affiche 2x
Voila mon code:

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 
'By Oliv' 29/06/2007 pour Outlook 2003
   Dim myRecipient As Outlook.Recipient
 
    If Not Item.Class = olMail Then GoTo fin
 
    Dim prompt As String
 
    ' ici renseigner le destinataire
 
 
 
    cci = "xxx@yyy.zzz"
 
    'commentez au choix l'option non voulue
 
    '########################Option CCI############################
 
    prompt = "Ajouter le cci " & cci & " à " & Item.Subject & "?"
 
If MsgBox(prompt, vbYesNoCancel + vbQuestion, "Sample") = vbCancel Then
Cancel = True
Exit Sub
 
 
    ElseIf MsgBox(prompt, vbYesNoCancel + vbQuestion, "Sample") = vbYes Then
 
        Set myRecipient = Item.Recipients.Add(cci)
 
        myRecipient.Type = olBCC
 
        myRecipient.Resolve
 
        If myRecipient.Resolved = False Then
 
            MsgBox "L'adresse Email n'est pas correcte !", vbCritical, "Erreur"
 
            Cancel = True
 
        End If
 
       End If
 
fin:
 
End Sub

Sinon ça marche mais il faut que je clic 2 fois sur oui.

**vynmarius** · 15/07/2015, 16h08

Envoyé par raf452

Sinon ça marche mais il faut que je clic 2 fois sur oui.

Je pense que ça se passe sur le "ElseIf MsgBox(prompt, vbYesNoCancel + vbQuestion, "Sample") = vbYes Then", il faut remplacer l'ensemble par un Else, je crois.

**Oliv-** · 16/07/2015, 11h08

Bonjour,
Il faut passer la réponse à une variable

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 
'By Oliv' 29/06/2007 pour Outlook 2003
   Dim myRecipient As Outlook.Recipient
 
    If Not Item.Class = olMail Then GoTo fin
 
    Dim prompt As String
 
    ' ici renseigner le destinataire
 
 
 
    cci = "xxx@yyy.zzz"
 
    'commentez au choix l'option non voulue
 
    '########################Option CCI############################
 
    prompt = "Ajouter le cci " & cci & " à " & Item.Subject & "?"
dim reponse
reponse= MsgBox(prompt, vbYesNoCancel + vbQuestion, "Sample") 
 
If reponse= vbCancel Then
Cancel = True
Exit Sub
 
 
    ElseIf reponse = vbYes Then
 
        Set myRecipient = Item.Recipients.Add(cci)
 
        myRecipient.Type = olBCC
 
        myRecipient.Resolve
 
        If myRecipient.Resolved = False Then
 
            MsgBox "L'adresse Email n'est pas correcte !", vbCritical, "Erreur"
 
            Cancel = True
 
        End If
 
       End If
 
fin:
 
End Sub

**raf452** · 16/07/2015, 11h53

Merci!

Ça marche parfaitement!

J'espère un jour (quand je serais grand) être aussi fort!

**vynmarius** · 16/07/2015, 14h08

bien vu ! et ça a le mérite d’éclaircir le programme

**fredouillebb** · 15/09/2017, 20h23

bonjour,

Permettez-moi de rouvrir cette discussion quelques années après...

Etant néophyte en vba, j'aimerais revenir sur le programme d'Oliv-sensei.
Je souhaiterais étendre l'envoi d'un mail à plusieurs adresses, cela passe très certainement par un changement de variable qui m'échappe totalement.

Le principe reste le même à savoir à l'envoi du mail mais en intégrant de nouveaux destinataires en cc.

Merci par avance du temps accordé à ma demande.

**Oliv-** · 18/09/2017, 10h20

Bonjour,

j'ai pas testé, mais ca doit fonctionner

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Private Sub Application_ItemSend(ByVal Item As Object, _
 
Cancel As Boolean)
 
'By Oliv' 29/06/2007 pour Outlook 2003/2010/etc
 
Dim myRecipient As Outlook.Recipient
 
If Not Item.Class = olMail Then GoTo fin
 
Dim prompt As String
 
' ici renseigner les destinataires
 
cci = array("MonDestinataire@sonDomaine.fr","mondestinataire2.toto.fr","etc.toto.fr")
 
'commentez au choix l'option non voulue
 
'########################Option CCI############################
 
'prompt = "Ajouter le cci " & cci & " à " & Item.Subject & "?"
'If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbYes Then
'Set myRecipient = Item.Recipients.Add(cci)
 'myRecipient.Type = olBCC
 'myRecipient.Resolve
'If myRecipient.Resolved = False Then
'MsgBox "L'adresse Email n'est pas correcte !", vbCritical, "Erreur"
'Cancel = True
'End If
'End If
 
'########################Option CC##############################
For i = 1 to ubound(cci)
prompt = "Ajouter le cc " & cci (i) & " à " & Item.Subject & "?"
 
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbYes Then
 
Set myRecipient = Item.Recipients.Add(cci(i))
 
myRecipient.Type = olCC
 
myRecipient.Resolve
 
If myRecipient.Resolved = False Then
 
MsgBox "L'adresse Email n'est pas correcte !", vbCritical, "Erreur"
 
Cancel = True
End If
 
End If
next i
 
'#######################FIN#####################################
 
fin:
 
End Sub

**fredouillebb** · 18/09/2017, 15h46

Bonjour,

J'apprécie votre réponse éclair !

En effet le code fonctionne excepté un petit bémol que j'ai corrigé.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
cci = array("MonDestinataire@sonDomaine.fr","mondestinataire2.toto.fr","etc.toto.fr")
 
For i = 1 to ubound(cci)

J'ai remarqué que dans votre boucle votre i=1 du coup c'est comme si vous commencez à n+1 par conséquent vous ne prenez pas la première adresse
j'ai changé i=1 en i=0 et cela marche nickel !

Merci à vous pour votre patience et votre prompte réponse

Oliv-sensei !

**lulubrock** · 25/05/2020, 18h13

Bonjour,

@Oliv- le code est vraiment super et marche très bien. Est-ce que tu aurais une version de ce code qui n'affiche pas à chaque fois la petite fenêtre qui demande la validation? En effet, j'envoie parfois un nombre très important de mails, et il me faudrait cliquer à chaque fois pour chaque email, ce qui est un peu long.
Je souhaiterais que l'adresse voulue se mette directement en CCI sans avoir à rien valider.

Je te remercie pour ton aide !!

Lucas