Compare two Outlook folders to filter emails not in second folder

Question

I've come across several email filtering solution but couldn't solve my problem using those ideas.

How do I compare two Outlook folders and based on the first folder filter out the emails not in the second folder according to SentOn or ReceiveTime and copy those mails to the second folder?

I can get the mails in both folders using If sMail.SentOn = dMail.SentOn.
If I alter the condition to If sMail.SentOn <> dMail.SentOn it is not working.

Sub FindMails()
    Dim olApp As Outlook.Application
    Dim olNS As NameSpace
    Dim olFolder As Folder
    Dim olFolder2 As Folder
        
    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.Folders.Item("hayat_archive_Loc").Folders.Item("Inbox")
    Set olFolder2 = olNS.Folders.Item("Xhayat_archive_Loc").Folders.Item("Inbox")

    For Each sMail In olFolder.Items
        For Each dMail In olFolder2.Items
            If sMail.SentOn <> dMail.SentOn Then
                Debug.Print sMail.SentOn & vbTab & sMail.Subject
            End If
        Next
    Next
End Sub

Debug Output If sMail.SentOn = dMail.SentOn

9/9/2017 12:27:34 PM    Access Problem
9/9/2017 9:07:33 AM     Report on 08-Sep-2017.
9/9/2017 6:39:51 AM     Handover of 08th September, 2017

Debug Output If sMail.SentOn <> dMail.SentOn

9/9/2017 12:38:36 PM    Access Problem
9/9/2017 12:38:36 PM    Access Problem
9/9/2017 12:38:36 PM    Access Problem
9/9/2017 12:27:34 PM    Access Problem
9/9/2017 12:27:34 PM    Access Problem
9/9/2017 9:10:13 AM     Egress (09-September-2017)
9/9/2017 9:10:13 AM     Egress (09-September-2017)
9/9/2017 9:10:13 AM     Egress (09-September-2017)
9/9/2017 9:07:33 AM     Report on 08-Sep-2017.
9/9/2017 9:07:33 AM     Report on 08-Sep-2017.
9/9/2017 7:23:41 AM     Password reset
9/9/2017 7:23:41 AM     Password reset
9/9/2017 7:23:41 AM     Password reset
9/9/2017 7:04:55 AM     Report on 08-Sep-2017.
9/9/2017 7:04:55 AM     Report on 08-Sep-2017.
9/9/2017 7:04:55 AM     Report on 08-Sep-2017.
9/9/2017 6:39:51 AM     Handover of 08th September, 2017
9/9/2017 6:39:51 AM     Handover of 08th September, 2017
9/9/2017 2:45:18 AM     Usages report on 07th September , 2017
9/9/2017 2:45:18 AM     Usages report on 07th September , 2017
9/9/2017 2:45:18 AM     Usages report on 07th September , 2017

You say "its not working" but do not say how it is not working. — Tony Dallimore
I would not use Restul and MsgBox as you have. I would replace Restul = Restul & sMail.Subject & vbCrLf with Debug.Print sMail.Subject. Debug.Print outputs to the Immediate Window which you can study at your leisure or use Copy & Paste to transfer its contents elsewhere. You cannot do either with MsgBox. The Immediate Window will accept 200 or so lines before the oldest lines are lost. If 200 is not enough I will show you how to output to a file. — Tony Dallimore
I would not rely on a single date as the match between two emails. It is unlikely that two emails are sent within the same second but it is possible. I would check Sender, Recipients, HtmlBody, Body and any other property I cared about to be absolutely certain the emails were identical. — Tony Dallimore
@TonyDallimore Thanks, I will use Debug.Print, would you show me some hints to use all of those validating points to write a proper function , I am a beginner here , — Hayat Hasan
Also my main focus for this question was why If sMail.SentOn <> dMail.SentOn was not working, Debug.Print return same as msgbox in this case. Which is, it suppose to return emails those are not same SentOn in both folder, But rather it return each emails multiple times . — Hayat Hasan

Hayat Hasan Hayat Hasan · Accepted Answer · 2017-09-10T05:28:21

Partially I got answer for this question from this post:

Check and Copy all emails from source folder those are not existed in destination folder

Answered by: Tim Williams

Sub CopyMail(SourceFolder As Outlook.Folder, DestinationFolder As Outlook.Folder)
Dim sMail As Object
Dim dMail As Object
Dim MailC As Object
Dim dictSent As New Scripting.dictionary, i As Long

'get a list of all unique sent times in the
'  destination folder
For Each dMail In DestinationFolder.Items
    dictSent(dMail.SentOn) = True
Next

'loop through the source folder and copy all items where
'  the sent time is not in the list
For i = SourceFolder.Items.Count To 1 Step -1
    Set sMail = SourceFolder.Items(i)

    If Not dictSent.Exists(sMail.SentOn) Then
        Set MailC = sMail.Copy        'copy and move
        MailC.Move DestinationFolder
        dictSent(sMail.SentOn) = True 'add to list
    End If

Next i

End Sub

Compare two Outlook folders to filter emails not in second folder

1 Answers