С некоторым VBA. Всегда хорошая идея, чтобы тщательно проверить, когда удаление.
Private Sub Application_NewMail()
' In ThisOutlookSession module
' see Create Outlook Rules Programmatically
' http://msdn.microsoft.com/en-us/library/aa163981(v=office.10).aspx
Dim olApp As Outlook.Application
Dim olNs As Outlook.NameSpace
Dim olFld As Outlook.MAPIFolder
Dim objMail As Object
Set olApp = Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFld = olNs.GetDefaultFolder(olFolderInbox)
olFld.items.sort "Received", False
'Set objMail = olFld.items.GetFirst ' In Outlook 2003
Set objMail = olFld.items.GetLast ' In Outlook 2010
If TypeOf objMail Is MailItem Then
If objMail.SenderEmailAddress = "Found in DetermineSenderEmailAddress" And _
InStr(1, objMail.Subject, "Ticket:") Then
DeleteOldStatus objMail
End If
End If
Set objMail = Nothing
Set olFld = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
Sub DeleteOldStatus(objMail As MailItem)
Dim olFld As folder
Dim olNs As NameSpace
Dim olderMail As MailItem
Dim iDel As Long
Set olNs = Application.GetNamespace("MAPI")
Set olFld = olNs.GetDefaultFolder(olFolderInbox)
For iDel = olFld.items.Count To 1 Step -1
Set olderMail = olFld.items(iDel)
If olderMail.Subject = objMail.Subject Then
If olderMail.ReceivedTime < objMail.ReceivedTime Then
Debug.Print olderMail.Subject & " received " & olderMail.ReceivedTime & " should be deleted."
'olderMail.Delete ' Remove leading apostrophe to uncomment when ready
End If
End If
Next
Debug.Print "Done - " & objMail.Subject
End Sub
Sub DetermineSenderEmailAddress()
' open up an email then run
Dim currItem As MailItem
Set currItem = ActiveInspector.currentItem
' Copy the text from the immediate pane.
Debug.Print currItem.SenderEmailAddress
End Sub
Справка для редактора и кнопки - http://www.slipstick.com/developer/how-to-use-outlooks-vba-editor/
Безопасность макросов должна быть установлена на средний уровень.
Справка по кнопкам - http://www.howto-outlook.com/howto/macrobutton.htm
Редактировать: Исправлена строка InStr