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
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
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 207
Downloads 72
CodeID
DB ID
![](/Assets/UsersPics/userpic_3M62Ihum9O.jpg)
ANmarAmdeen
642
Revisions
v1.0
Saturday
December
31
2022
![](/Assets/img/_load903.gif)