OutlookFindDuplicate.vbs

Option Explicit

Public Sub FindDuplicate()
    Dim i As Long
    Dim myOlItems As Outlook.Items
    Dim myOlMailItem1, myOlMailItem2 As Outlook.mailItem
    
    Set myOlItems = Application.ActiveExplorer.CurrentFolder.Items
    myOlItems.Sort "ReceivedTime", True

    i = 1
    While i < 20000 And i < myOlItems.Count
        If TypeName(myOlItems(i)) = "MailItem" And TypeName(myOlItems(i + 1)) = "MailItem" Then
            Set myOlMailItem1 = myOlItems(i)
            Set myOlMailItem2 = myOlItems(i + 1)
            
            If myOlMailItem1.subject = myOlMailItem2.subject _
               And myOlMailItem1.ReceivedTime = myOlMailItem2.ReceivedTime _
            Then
                ActiveExplorer.Activate
                ActiveExplorer.ClearSelection
                ActiveExplorer.AddToSelection myOlItems(i)
                ActiveExplorer.AddToSelection myOlItems(i + 1)
                Debug.Print myOlItems(i).ReceivedTime & " " & myOlItems(i).subject
                i = 99999
            End If
        End If
        i = i + 1
    Wend
End Sub