OverlandPark
New Member
- Outlook version
- Outlook 2013 64 bit
- Email Account
- Exchange Server
I am trying to write a small script by which I can remove duplicate mail items to a separate folder. I am using Outlook 2013 in a Windows 7 64-bit environment.
I would appreciate help with the following code.
I recognize this code is not efficient, but I just need to get it to run.
Thank you.
Sub RemoveDuplicates()
Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myItems As Outlook.Items
Dim Duplicates As Outlook.MAPIFolder
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.PickFolder
Set Duplicates = myNameSpace.PickFolder
Set myItems = myFolder.Items
For i = 1 To myItems.Count
For j = i + 1 To myItems.Count
DoEvents
On Error Resume Next
If myItems(i).Subject = myItems(j).Subject Then
If myItems(i).ReceivedByName = myItems(j).ReceivedByName Then
If myItems(i).Sender = myItems(j).Sender Then
If myItems(i).SentOn = myItems(j).SentOn Then
If myItems(i).Body = myItems(j).Body Then
myItems(i).Move Duplicates
End If
End If
End If
End If
End If
Next
Next
End Sub
I would appreciate help with the following code.
I recognize this code is not efficient, but I just need to get it to run.
Thank you.
Sub RemoveDuplicates()
Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myItems As Outlook.Items
Dim Duplicates As Outlook.MAPIFolder
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.PickFolder
Set Duplicates = myNameSpace.PickFolder
Set myItems = myFolder.Items
For i = 1 To myItems.Count
For j = i + 1 To myItems.Count
DoEvents
On Error Resume Next
If myItems(i).Subject = myItems(j).Subject Then
If myItems(i).ReceivedByName = myItems(j).ReceivedByName Then
If myItems(i).Sender = myItems(j).Sender Then
If myItems(i).SentOn = myItems(j).SentOn Then
If myItems(i).Body = myItems(j).Body Then
myItems(i).Move Duplicates
End If
End If
End If
End If
End If
Next
Next
End Sub