Bonjour à tous,

Je suis débutant en VBA.

J'ai réussi à créer une macro qui permet d'envoyer un mail identique et automatique a la colonne d'adresse mails dés qu'ils ont été selectionné par une croix dans la colonne suivante. Mon problème est qu'il y a des adresses en double voir en triple et que ma macro envoi le même nombre de mails qu'il y a de doublons.
J'aimerais donc que la macro me filtre les doublons avant l'envoi du mail mais sans les supprimer de mon tableau excel.

J'espère m'être fait comprendre.

Voici ma 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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub Envoyer_Mail_Outlook()
' Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"
 
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
Dim Plage As Range, R As Range
Dim ListeMails As String
 
    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)
 
'---------------------------------------------------------
   'Exemple pour envoyer un classeur en pièce jointe
   'Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
   'If Nom_Fichier = "Faux" Then Exit Sub
'---------------------------------------------------------
   'Ou bien entrer le path et nom du fichier autrement
   Nom_Fichier = Application.GetOpenFilename("Copie de Projets ASD 3 4 FAE(*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
    If Nom_Fichier = "Faux" Then Exit Sub
'---------------------------------------------------------
'Collecte les cellules contenant une croix en colonne E
    Set Plage = Range("H5:H326").SpecialCells(xlCellTypeConstants, 2)
    'Pour chaque cellule collectée
    For Each R In Plage
        'On récupère l'adresse mail en colonne précédente(D)
        ListeMails = ListeMails & IIf(Len(ListeMails) > 0, ";", "") & R.Offset(0, -1).Text
    Next R
 
     With oBjMail
        .To = ListeMails ' le destinataire
       .Subject = "test"          ' l'objet du mail
       .Body = "essai essai essai"
       .Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
       .Send
    End With
 
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
 
 
End Sub

Merci pour vos réponse.

Cordialement,