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