Outlook has downloaded all my email from the server several times, so I have many duplicate emails. I have several thousand emails and deleting them manually would take hours.

I am trying to write VBA code to delete the duplicates. My code is a work in progress, but it is shown below. The problem I am having is that when I loop through the MailItems in my folders, VBA seems to ignore the duplicates. I load the folder into an Object variable, and then I interate through the MailItems in that folder/Object, the duplicates do not show up, so the code does not delete them.

While testing I exit the loop after 25 emails, and I do not actually delete the mailitems until I have a working way of identifying the duplicates.

Your assistance is greatly appreciated.
Thanks,
Kevin Yearian


[vba]Public Sub deleteDuplicate()
Dim MyNS As NameSpace
Set MyNS = Application.GetNamespace("MAPI")
Dim fldFolder As MAPIFolder
'Dim fldSubFolder As MAPIFolder
Set fldFolder = MyNS.Folders("Personal Folders")
Set fldEmail2005 = fldFolder.Folders("Email 2005")
Dim objItem As Object
Dim mItem As mailItem

Dim prevSubject As String
Dim prevCreateDate As String
Dim prevSize As Long
Dim thisSubject As String
Dim thisCreateDate As String
Dim thisSize As Long

Dim count As Integer
count = 0
For Each objItem In fldEmail2005.Folders
MsgBox objItem.Name
prevSubject = ""
prevCreateDate = ""
prevSize = 0
For Each mItem In objItem.Items

count = count + 1

If count = 25 Then
Exit For
End If
thisSubject = mItem.Subject
thisCreateDate = mItem.CreationTime
thisSize = mItem.Size
If thisSubject <> prevSubject Then
prevSubject = thisSubject
thisCreateDate = prevCreateDate
prevSize = thisSize
ElseIf thisCreateDate <> prevCreateDate Then
prevSubject = thisSubject
thisCreateDate = prevCreateDate
prevSize = thisSize
ElseIf thisSize <> prevSize Then
prevSubject = thisSubject
'thisCreateDate = prevCreateDate
prevSize = thisSize
Else
MsgBox "Duplicate Entry found"
End If

Next mItem
If count = 25 Then Exit For
Next objItem
End Sub[/vba]