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 141
Downloads 42
CodeID
DB ID
ANmarAmdeen
610
Revisions
v1.0
Saturday
December
31
2022