1

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
Community
  • 1
  • 1
Hayat Hasan
  • 229
  • 2
  • 14
  • You say "its not working" but do not say how it is not working. – Tony Dallimore Sep 09 '17 at 14:27
  • 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 Sep 09 '17 at 14:27
  • 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 Sep 09 '17 at 14:28
  • @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 Sep 09 '17 at 14:32
  • 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 Sep 09 '17 at 14:44

2 Answers2

1

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
Hayat Hasan
  • 229
  • 2
  • 14
0

You can try: Debug.print dMail.Subject instead of sMail.Subject

This will give you your answer.

Ike
  • 9,580
  • 4
  • 13
  • 29
Daniel
  • 11
  • 1