Private WithEvents olItems As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub olItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
Dim receivedMail As Outlook.MailItem
Dim sentMail As Object
Dim sentFolder As Outlook.Folder
Set receivedMail = Item
Set sentFolder = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
For Each sentMail In sentFolder.Items
If TypeOf sentMail Is Outlook.MailItem And sentMail.ConversationID = receivedMail.ConversationID And sentMail.FlagStatus = olFlagMarked Then
sentMail.ClearTaskFlag
sentMail.Save
Exit For
End If
Next sentMail
End If
End Sub