Outlook Emails nach dem lesen automatisch in bestimmte Ordner sortieren

Dim WithEvents exp As Explorer
Dim WithEvents cItem As MailItem
Dim WithEvents oldItem As MailItem

Private Sub Application_MAPILogonComplete()
    Set exp = ActiveExplorer
End Sub

Private Sub exp_SelectionChange()
    If exp.Selection.Count > 0 Then
        With exp.Selection.Item(1)
            If .Class = olMail Then
                Set oldItem = cItem
                Set cItem = exp.Selection.Item(1)
            End If
        End With
    End If
End Sub

Private Sub oldItem_PropertyChange(ByVal Name As String)
    If Name = "UnRead" And oldItem.UnRead = False Then  
        MoveItemToArchive oldItem
    End If
End Sub

Private Sub cItem_PropertyChange(ByVal Name As String)
    If Name = "UnRead" And cItem.UnRead = False Then  
        MoveItemToArchive cItem
    End If
End Sub

Sub MoveItemToArchive(ByVal itm As MailItem)
    On Error Resume Next
    Select Case LCase(itm.SenderEmailAddress)
        Case "werbung@mercedes-whatever.de"  
            itm.Move exp.CurrentFolder.Store.GetRootFolder.Folders("Newsletter").Folders("Mercedes")  
        Case Else
            itm.Move exp.CurrentFolder.Store.GetRootFolder.Folders("Newsletter")  
    End Select
End Sub