Outlook 2007: как я могу автоматически удалить старые версии сообщения

Question

Я получаю автономные сообщения по электронной почте, которые дают мне представление о состоянии различных систем в моей компании. Я хочу, чтобы Outlook автоматически перемещал самое новое сообщение о состоянии в указанную папку, а затем удалял предыдущие сообщения в этой папке. Каков наилучший способ сделать это?

Answer 1

Когда в папке «Входящие» появляется новая почта, это программное правило находит папку, удаляет ее содержимое и перемещает в нее новую почту.

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

' GetFirst used to work in Outlook 2003 now it is GetLast in Outlook 2010   
Set objMail = olFld.items.GetLast

If TypeOf objMail Is MailItem Then
    DeleteBeforeNewStatus objMail
End If

Set objMail = Nothing
Set olFld = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub


Sub DeleteBeforeNewStatus(objMail As MailItem)
' In any module 

Dim olFld As folder
Dim olNs As NameSpace

Dim olderMail As MailItem
Dim iDel As Long

Set olNs = Application.GetNamespace("MAPI")

Select Case objMail.Subject

    Case "System A Status"
        Set olFld = olNs.GetDefaultFolder(olFolderInbox).Folders("SystemA")

    Case "System B Status"
        Set olFld = olNs.GetDefaultFolder(olFolderInbox).Folders("SystemB")

    Case Else
        Set olNs = Nothing
        Exit Sub

End Select

For iDel = olFld.items.Count To 1 Step -1
    Set olderMail = olFld.items(iDel)
    olderMail.Delete
Next

 objMail.Move olFld

End Sub

Создайте две тестовые папки прямо под папкой «Входящие» для тестирования. Если это работает, добавьте столько экземпляров этих двух строк, сколько требуется.

 Case "System X Status"
      Set olFld = olNs.GetDefaultFolder(olFolderInbox).Folders("SystemX")

Если папки зарыты глубже, вам нужно будет указать путь в этом формате.

Установите olFld = olNs.GetDefaultFolder(olFolderInbox).Папки ("Subfolder1").Папки (Subfolder2").Папки ("SystemX")

Справка для редактора и кнопки - http://www.slipstick.com/developer/how-to-use-outlooks-vba-editor/

Безопасность макросов должна быть установлена на средний уровень.

Справка по кнопкам - http://www.howto-outlook.com/howto/macrobutton.htm