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