ajouter des destinataires (CC) avant d'envoyer un mail

**LANGAZOU** · 01/02/2016, 11h19

Bonjour le Forum,

je voudrais savoir le code qui me permettrai d'ajouter des destinataires en copie (CC) avant d'envoyer mon mail.Le "Recipent.add" permet uniquement d'ajouter des destinataires principales et non pas en copies.

Merci pour votre aide.

**antonysansh** · 01/02/2016, 11h55

Bonjour LANGAZOU

De mémoire c'est CC.Add (non testé)

Invité · 01/02/2016, 12h35

Bonjour,
Outlook? CDO? Lotus?
http://www.developpez.net/forums/d14...t/#post7968025

**LANGAZOU** · 01/02/2016, 13h56

salut,

Mr antonysansh , non ça ne fonctionne pas avec "CC.add ".

Mr rdurupt , je travaille sous EXCEL 2010.

Merci.

Invité · 01/02/2016, 14h32

ma question ne portais pas sur la version d'Excel, mais sur le client lourd (logiciel Mail).
pour Outlook ou Cdo la réponse est dans le lien!

**LANGAZOU** · 01/02/2016, 15h42

salut,

c'est pour OUTLOOK.

Merci

**antonysansh** · 01/02/2016, 15h53

Donc Rdurupt et moi t'avons déjà répondu.

Regarde dans la propriété .CC de ton objet MailItem
Exemple :

Code :

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

1
2
3
With MonMail
    .CC = "copiecache@mail.truc"
End With

**LANGAZOU** · 01/02/2016, 16h13

re bonjour,

Merci de noter que ma macro (sous Excel) répond automatiquement à un mail déjà sélectionné sur OUTLOOK(MailOutLook = ObjCurrentMessage.ReplyAll). par conséquent lorsque j'utilise le ".CC = "copiecache@mail.truc"" elle efface toutes les destinataires en copie en gardant uniquement "copiecache@mail.truc".mon but c'est d'ajouter des destinataires (en gardant les destinataires en copie du mail sélectionné).

Merci de votre retour.

Invité · 01/02/2016, 16h20

normal .CC correspond au destinataire en copy pas en copy cache!

Code :

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

.BCC= "copiecache@mail.truc""

si tu avais regardé mon lien tu l’aurais vu!

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
With MailObj
    .To = Destinataire
    .CC = DestinataireCopy
    .BCC = DestinataireCopyCacher
    .Subject = Sujet
    .BodyFormat = 2
    .HTMLBody = Message
    If Trim("" & Pj) <> "" Then
        p = Split(Pj & ";", ";")
        For i = 0 To UBound(p)
            If Trim("" & p(i)) <> "" Then .Attachments.Add Trim("" & p(i))
        Next
    End If
    '.Display 'Can be .Send but prompts for user intervention before sending without 3rd party software like ClickYes
    .Send
End With

**LANGAZOU** · 01/02/2016, 16h43

slt,

vous n'avez pas compris ma demande.mon but c'est d'ajouter des destinataires en copie et non pas cachés (en gardant les destinataires en copie du mail sélectionné).

Invité · 01/02/2016, 16h47

Envoyé par LANGAZOU

re bonjour,

Merci de noter que ma macro (sous Excel) répond automatiquement à un mail déjà sélectionné sur OUTLOOK(MailOutLook = ObjCurrentMessage.ReplyAll). par conséquent lorsque j'utilise le ".CC = "copiecache@mail.truc"" elle efface toutes les destinataires en copie en gardant uniquement "copiecache@mail.truc".mon but c'est d'ajouter des destinataires (en gardant les destinataires en copie du mail sélectionné).

Merci de votre retour.

désolé:

Code :

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

.CC= .CC & ";copiecache@mail.truc"

**LANGAZOU** · 01/02/2016, 16h59

Merci beaucoup c'est ce que je cherchais ;-)

une dernière question: Comment faire pour empêcher le add du " .CC= .CC & ";copiecache@mail.truc " si l'adresse mail existe déjà parmi les destinataires en copies ?

Merci infiniment.

Invité · 01/02/2016, 17h09

if instr(.cc,"copiecache@mail.truc") =0 then .cc=.cc & ";copiecache@mail.truc "

**LANGAZOU** · 03/02/2016, 08h55

Bonjour rdurupt,

J'ai essayé ta proposition mais ça ne marche pas si l’adresse mail se trouve au milieu des destinataires CC. j'ai fait cette modification mais ça ne fonctionne toujours pas :/

Code :

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

1
2
3
4
5
If InStr(1, MailOutLook.CC, "copiecache@mail.truc", vbTextCompare) = 0 Then
 
MailOutLook.CC = .CC & ";copiecache@mail.truc>"
 
End If

Merci.

**Oliv-** · 03/02/2016, 12h01

Bonjour,

.bcc ou . cc est une méthode rapide mais on peut aussi utiliser la méthode .recipients.add

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
 
  Dim objRecipient As Outlook.Recipient
        'Ajout d'un destinataire principal
        Set objRecipient = .Recipients.add("toto@toto.com")
        objRecipient.Type = olTo    
        objRecipient.Resolve
 
        'Ajout d'un destinataire en copie
        Set objRecipient = .Recipients.add("titi@toto.com")
        objRecipient.Type = olCC    'olBCC, olCC, olOriginator ou olTo.
        objRecipient.Resolve
 
 
'Ajout d'un destinataire en copie cachée
        Set objRecipient = .Recipients.add("titi@toto.com")
        objRecipient.Type = olBCC
        objRecipient.Resolve

C'est pas forcément grave si ton destinataire est en double à priori il ne le recevra qu'une fois.

**LANGAZOU** · 03/02/2016, 15h00

Bonjour Oliv-,

J'espère que vous allez bien ;-)

y'a t-il un moyen d'ajouter des destinataires en copie que s'ils n'existaient pas ?

**Oliv-** · 03/02/2016, 16h11

Re,
tu ajoutes tes destinataires puis tu lances cette macro

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
Sub PurgeRecipients()
    Dim objOL As Outlook.Application
    Dim objMail As MailItem
    Dim MyRecips As Recipients
    Dim ThisRecip As Recipient
 
    Set objOL = CreateObject("Outlook.Application")
    Set objMail = objOL.ActiveInspector.CurrentItem
    Set MyRecips = objMail.Recipients
    Dim mondico As Object
    Set mondico = CreateObject("Scripting.Dictionary")
 
    For Each ThisRecip In MyRecips
        'eventuellement tester le Type olBCC, olCC, olOriginator ou olTo
        'If ThisRecip.Type = olTo Then MsgBox "A:" & ThisRecip & "-" & ThisRecip.Address
 
 
        If Not mondico.Exists(ThisRecip.Address) Then
            mondico.add ThisRecip.Address, ThisRecip.Address
        Else    'doublon
            ThisRecip.Delete
        End If
    Next
 
End Sub

**LANGAZOU** · 05/02/2016, 10h03

Bonjour Oliv-,

J'ai fait le call de votre macro (sans faire de modification) à la fin mais ça déboge ( Erreur de compilation: type défini par l'utlisateur non défini)

Merci pour votre réponse.

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
Function GetCurrentItem() As Object
    Dim objApp As Object
 
    'Set objApp = Application
Set objApp = CreateObject("Outlook.Application")
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
 
    Set objApp = Nothing
End Function
 
Sub mail
 
Dim objApp As Object
Dim MailOutLook As Object
Dim Fichier As String
Dim rep_fic As String
Dim strbody As String
 
Set objApp = CreateObject("Outlook.Application")
 
rep_fic = "C:/Desktop/Fichier"
 
Set MailOutLook = ObjCurrentMessage.ReplyAll
 
strbody = "<BODY style=font-size:12pt;font-family:Calibri> Bonjour, <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Veuillez ... <br>" _
          & "<br>" _
          & "<BODY style=font-size:12pt;font-family:Calibri>Bonne réception." & "<br>" _
 
 
 
 
With MailOutLook
 
.Display
.Subject = "Facture" 
.CC = .CC & "TOTO @yahoo.fr"
.Recipients.ResolveAll
.HTMLBody = strbody & "<br>" & .HTMLBody
.Attachments.Add rep_fic
 
.Display
 
End With
 
Set MailOutLook = Nothing
Set appOutLook = Nothing
 
Call PurgeRecipients
 
end sub

**Oliv-** · 05/02/2016, 10h16

Bonjour,
Il faut un peu l'adapter :

dans ta macro

Code :

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

Call PurgeRecipients (mailoutlook)

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
Sub PurgeRecipients(objMail As MailItem)
    Dim MyRecips As Recipients
    Dim ThisRecip As Recipient
 
    Set MyRecips = objMail.Recipients
    Dim mondico As Object
    Set mondico = CreateObject("Scripting.Dictionary")
 
    For Each ThisRecip In MyRecips
        'eventuellement tester le Type olBCC, olCC, olOriginator ou olTo
        'If ThisRecip.Type = olTo Then MsgBox "A:" & ThisRecip & "-" & ThisRecip.Address
 
 
        If Not mondico.Exists(ThisRecip.Address) Then
            mondico.add ThisRecip.Address, ThisRecip.Address
        Else    'doublon
            ThisRecip.Delete
        End If
    Next
 
End Sub