Outlook: To move earlier emails of same thread to sub-folder

[Ljame]

Hi All,

My requirement is to move earlier emails of same thread to a sub-folder and only the recent/latest email to be in the primary folder.
That is , when we sort emails by subject and if 5 mails for same subject then except the latest email , rest should be moved to sub-folder.
And if the new email arrives on same subject to primary folder then the older ones should move to sub-folder. Could you please help me.

Please suggest. Thanks.

[Artik]

Because Ljame has a problem with editing the post, I put here what I received in PM.
[QUOTE = Ljame; 392016] I am trying to move all but not the latest email of same thread (subject wise) to a sub folder. The below code does it but upon every loop it gets error "Method 'ReceivedTime' of object '_MailItem' failed” on debug its on line "comparisonItemAge=today - mItem.ReceivedTime.
So, upon clicking debug and rerun it moves the old email then again gets same error.
Could you please review and help me to resolve this issue. Thanks. [/ QUOTE]

Dim nSpace As Outlook.NamespaceDim targetFolder As MAPIFolder
Dim desFolder As MAPIFolder
Dim mItem As MailItem
Dim comparisonItem As MailItem
Dim tempSubject As String
Dim today As Date




Private Sub Application_NewMail()
Set nSpace = GetNamespace("MAPI")
Set targetFolder = nSpace.Folders("abc@abc.com").Folders("Inbox").Folders("TAR_TEST")
Set desFolder = nSpace.Folders("abc@abc.com").Folders("Inbox").Folders("DES_TEST")




For Each mItem In targetFolder.Items
tempSubject = mItem.Subject
    While InStr(1, Left(tempSubject, 3), "RE:") > 0 Or InStr(1, Left(tempSubject, 4), "FW:") > 0
        tempSubject = Mid(tempSubject, 5)
    Wend




    For Each comparisonItem In targetFolder.Items
        If InStr(1, comparisonItem.Subject, tempSubject) > 0 Then
            today = Now()
            currentItemAge = today - comparisonItem.ReceivedTime
            comparisonItemAge = today - mItem.ReceivedTime
            If currentItemAge < comparisonItemAge Then
                mItem.Move desFolder
                Exit For
            End If
      
            If currentItemAge > comparisonItemAge Then
                comparisonItem.Move desFolder
                Exit For
            End If
        End If
    Next
  Next




Set targetFolder = Nothing
Set desFolder = Nothing
Set nSpace = Nothing
End Sub