[OL-2010] Suppression des doublons [Résolu]

[JOHN14]

Bonjour/Bonsoir à tous

Je ne sais plus ce que j'ai bricolé (probablement "Télécharger les en-têtes"), mais il se trouve que tous mes les messages de mes divers comptes sont doublés
Je venais tout juste de finir mon classement.

Quelqu'un aurait-il la bonté divine de me dire comment défaire ce qui n'aurait pas dû être fait. Et surtout, comment ne pas le refaire !

Merci.

[carden752]

Bonjour,

Un doublon, c'est quoi pour toi?
Même date de création et même expéditeur, même destinataire, même sujet et même corps du message?
Si tel est le cas on peut faire en VBA ces tests et les supprimer automatiquement s'ils existent (Pour être sûr copie dans un dossier bidon puis suppression après).

[JOHN14]

Bonjour,

En fais comme j'essaie de changer de messagerie (anciennement sur Opéra) je laisse une copie du message sur le serveur. Les messages en doubles sont une deuxième import des messages précédents mais non classés. Ils ont même date, même expéditeur, même destinataire, même sujet et même corps du message.

[carden752]

Bonjour,

Quelque chose de ce style à tester :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub supprdoublon()
Dim mymail As MailItem, maildanslistmail As MailItem
Dim dossieratraiter As MAPIFolder, dossieraverifier As MAPIFolder
Set dossieratraiter = Outlook.Session.PickFolder
Set dossieraverifier = dossieratraiter
For Each mymail In dossieratraiter
    For Each maildanslistmail In dossieraverifier
    If mymail.EntryID <> maildanslistmail.EntryID And mymail.To = maildanslistmail.To And mymail.Subject = maildanslistmail.Subject And mymail.SenderName = maildanslistmail.SenderName And mymail.CreationTime = maildanslistmail.CreationTime And mymail.Body = maildanslistmail.Body Then
    maildanslistmail.Delete
    endif
    Next maildanslistmail
Next mymail
End Sub

[JOHN14]

Merci beaucoup.

Je n'ai pas le temps de le tester de suite mais je donnerai des nouvelles de ce programme.

PS. Cela peut prendre un peu de temps car je ne connais pas encore les objets d'Outlook.

[JOHN14]

Bonjour carden752,

Voilà j'ai testé ton code j'ai plusieurs remarques:

1) Dans le if, pourquoi le test "mymail.EntryID <> maildanslistmail.EntryID" ?
Mes doublons ont aussi le même "EntryID" et le teste est donc systématiquement négatif.

2) En exécutant le programme avec la condition "mymail.EntryID =maildanslistmail.EntryID" cela a fonctionné une fois puis dans le "For Each" l'instanciation de "mymail" avec un élément de "dossieraverifier.Items" provoque une erreur !

Pourriez-vous me dire pourquoi ?
Merci.

[JOHN14]

Bonjour à tous,
voici un code de recherche de doublons qui fonctionne. Libre à vous de le modifier et de l'utiliser...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Public Sub TrierLesDoublons()
 
    Dim FolderToTreat As Outlook.Folder, FolderToCheck As Outlook.Folder, ArrivalFolder As Outlook.Folder
    Dim i%, j%
 
    Set FolderToTreat = Outlook.Session.PickFolder
    Set ArrivalFolder = Outlook.Session.PickFolder
    Set FolderToCheck = FolderToTreat ' Pour les développements futures
 
 
    For i = 1 To FolderToTreat.Items.Count - 1
        For j = i + 1 To FolderToTreat.Items.Count
 
            If (FolderToTreat.Items(i) = FolderToTreat.Items(j)) Then
                Beep
                Call FolderToTreat.Items(i).Move(ArrivalFolder)
                Exit For
            End If
 
        Next j
    Next i
 
End Sub

Cordialement