OutlookFolder_DuplicatesCount

Counts emails with 1 or more duplicates in active folder in Outlook.
Still not sure how can I make it cleaner to run in outlook

CodeFunctionName
What is this?

Public

Tested

Original Work
Sub OutlookFolder_DuplicatesCount()
    Dim objInbox As Outlook.MAPIFolder
    Dim int1 As Long
    Dim objVariant As Variant
    Set objInbox = Application.ActiveExplorer.CurrentFolder ' Session.GetDefaultFolder(olFolderInbox)
    ThisFolder = objInbox.Name
    Dups = 0
    For int1 = objInbox.Items.Count To 1 Step -1
        Set objVariant = objInbox.Items.Item(int1)
        If objVariant.MessageClass = "IPM.Note" Then
            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: " & objVariant.SentOn & vbCrLf & _
                        "Subject: " & objVariant.Subject
                End If
                DoEvents
            Next
        Else
            'Stop
        End If
        DoEvents
    Next
    MsgBox "Done counting, found " & Format(Dups, "#,0") & " duplicated emails!", vbInformation
    Set objInbox = Nothing
End Sub

None

Once placed in module, just hit F5 key to run while desired folder is active.

Views 177

Downloads 63

CodeID
DB ID