Comment supprimer les anciens emails quand un nouveau courriel avec le même sujet est reçu

Question

Je ne parviens pas à supprimer e-mails avec la même ligne de sujet, mais en gardant l'e-mail nouvellement reçu sur Outlook vba

Est-ce que quelqu'un a des idées sur comment faire ça?

Answer 1

Vous pouvez travailler avec Dictionary Object stocker Items.Subject pendant que vous mesurez le reçu Item.ReceivedTime avec Item.ReceivedTime dans votre Inbox.Items

---

_{Dictionary in VBA est une collection objet: vous pouvez stocker tous sortes de choses dedans: nombres, textes, dates, tableaux, rangées, variables et objets, Chaque article dans un Dictiona ry obtient sa propre clé unique et Avec cette touche, vous pouvez obtenir un accès direct à l'élément (lecture/écriture).}

---

Maintenant, pour automatiser le processus - Essayez de travailler avec Application.Startup Event (Outlook) Et Items_ItemAdd Event (Outlook)

_{Items.ItemAdd Event Se produit quand un ou plusieurs éléments sont ajoutés à la collection spécifiée . Cet événement ne s'exécute pas lorsqu'un grand nombre d'éléments est ajouté au dossier en même temps.}

---

Exemple de code

Private WithEvents Items As Outlook.Items 
Private Sub Application_Startup() 
    Dim olNs As Outlook.NameSpace 
    Dim Inbox As Outlook.MAPIFolder 

    Set olNs = Application.GetNamespace("MAPI") 
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox) 
    Set Items = Inbox.Items 
End Sub 

Private Sub Items_ItemAdd(ByVal Item As Object) 
    If TypeOf Item Is Outlook.MailItem Then 
     RemoveDupEmails Item ' call sub 
    End If 
End Sub 

Private Sub RemoveDupEmails(ByVal Item As Object) 
    Dim olNs As Outlook.NameSpace 
    Dim Inbox As Outlook.MAPIFolder 
    Dim DupItem As Object 
    Dim Items As Outlook.Items 
    Dim i As Long 

    Set olNs = Application.GetNamespace("MAPI") 
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox) 
    Set Items = Inbox.Items 

    Debug.Print Item.ReceivedTime ' Immediate Window 

    Set DupItem = CreateObject("Scripting.Dictionary") 
    Set Items = Inbox.Items 

    Items.Sort "[ReceivedTime]" 

    For i = Items.Count To 1 Step -1 
     DoEvents 
     If TypeOf Items(i) Is MailItem Then 
      Set Item = Items(i) 

      If Item.ReceivedTime >= Items(i).ReceivedTime Then 

       If DupItem.Exists(Item.Subject) Then 
        Debug.Print Item.Subject ' Immediate Window 
        'Item.Delete ' UnComment to delete Item 
       Else 
        DupItem.Add Item.Subject, 0 
       End If 

      End If 

     End If 
    Next i 

    Set olNs = Nothing 
    Set Inbox = Nothing 
    Set DupItem = Nothing 
    Set Items = Nothing 
End Sub 

---