Erledigte Email verschieben

Möchten Sie erledigte Elemente gleich in einen anderen Ordner verschieben lassen? Das Beispiel zeigt, wie das grundsätzlich übers ItemChange-Ereignis eines Ordners geht. Hier heißt der Unterordner im Posteingang 'Ablage'.

In Outlook 2003 kann kein MailItem über die Move-Funktion verschoben werden, wenn das Element als erledigt markiert ist. Eine Lösung ist die Verwendung der CDO-Bibliothek.

  So fügen Sie Makros in Outlook ein

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace

  Set Ns = Application.GetNamespace("MAPI")
  Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemChange(ByVal Item As Object)
  MoveCompletedItem Item
End Sub

Private Sub MoveCompletedItem(Item As Object)
  Dim Ns As Outlook.NameSpace
  Dim Inbox As Outlook.MAPIFolder
  Dim Subfolder As Outlook.MAPIFolder
  Dim Mail As Outlook.MailItem
  Dim Msg As MAPI.Message
  Dim SubFolderName As String

  SubFolderName = "Ablage"

  If TypeOf Item Is Outlook.MailItem Then
    Set Mail = Item

    If Mail.FlagStatus = olFlagComplete Then
      Set Ns = Application.Session

      Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
      Set Subfolder = Inbox.Folders(SubFolderName)

      Set Msg = GetCDOMessage(Item)
      Msg.MoveTo Subfolder.EntryID, Subfolder.StoreID
    End If
  End If
End Sub

Private Function GetCDOMessage(Item As Object) As MAPI.Message
  On Error Resume Next
  Dim Session As MAPI.Session
  Dim sEntryID As String
  Dim sStoreID As String

  sEntryID = Item.EntryID
  sStoreID = Item.Parent.StoreID
  Set Session = CreateObject("MAPI.Session")
  Session.Logon , , False, False, , True
  Set GetCDOMessage = Session.GetMessage(sEntryID, sStoreID)
End Function