OutlookFolder_DuplicatesRemove

Removes duplicated emails in an outlook folder.
Originally not my work, modified and enhanced to work based on my conditions.
If two emails have same subject, sent date, and sender email then it will delete older one.

CodeFunctionName

What is this?

Public

Tested

Original Work

Sub OutlookFolder_DuplicatesRemove()
    Dim objInbox As Outlook.MAPIFolder
    Dim int1 As Long
    Dim objVariant As Variant
    Set objInbox = Application.ActiveExplorer.CurrentFolder ' Session.GetDefaultFolder(olFolderInbox)
    ThisFolder = objInbox.Name
    intMax = objInbox.Items.Count
    Dups = 0
    For int1 = intMax To 1 Step -1
        Set objVariant = objInbox.Items.Item(int1)
        If objVariant.MessageClass = "IPM.Note" Then
            DelMe = 0
            For int2 = int1 - 1 To 1 Step -1
                Cond1 = objVariant.Subject = objInbox.Items.Item(int2).Subject
                Cond2 = objVariant.SentOn = objInbox.Items.Item(int2).SentOn
                Cond3 = objVariant.SenderEmailAddress = objInbox.Items.Item(int2).SenderEmailAddress
                Cond4 = objVariant.EntryID = objInbox.Items.Item(int2).EntryID

                If Cond1 And Cond2 And Cond3 And Not Cond4 Then
                    Dups = Dups + 1
                    T1 = "Delete Msg1?" & vbCrLf & _
                        "Msg1: " & int1 & " / " & intMax & " " & objVariant.SentOn & vbCrLf & _
                        "Msg2: " & int2 & " / " & intMax & " " & objVariant.SentOn & vbCrLf & _
                        "Subject: " & objVariant.Subject
'                    Mss = MsgBox(T1, vbYesNoCancel + vbQuestion)
'                    If Mss = vbCancel Then Exit For
'                    If Mss = vbYes Then
                        DelMe = 1
                        Exit For
'                    End If
                End If
                DoEvents
            Next

            If DelMe = 1 Then
'                Stop
'                objVariant.MoveTo objInbox.Folders("Duplicated")
                objVariant.Delete
            End If
        Else
            Stop
        End If
        DoEvents
    Next
    MsgBox "Done deduplicating, removed " & Dups & " items!", vbInformation
    Set objInbox = Nothing
End Sub

None

Make sure you run it while folder is active, folder you want to remove its duplicates