PDA

View Full Version : Using VBA to delete duplicate emails



kwiz168
04-19-2005, 07:41 PM
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


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

Ken Puls
04-19-2005, 08:13 PM
Hi Kevin,

I can't actually help you with your issue, but I did edit your post to use our VBA tags.

a

Oh! And Welcome to VBAX! :yes

sandam
04-20-2005, 01:40 AM
the problem might stem from the folder object not holding the emails in the way you expect. It might be that you are actually getting to the duplicates but that they are not "stored" side by side in the folder object. You might try a while wend loop and compare the first mailitem to all mail items in the folder - that will point out for sure if you are getting the duplicates in the folder object. Or first sort your emails in your inbox by your first condition and then run the code??

HTH
ANdrew;?