Mails am Jahresende verschieben in Jahresordner

' Outlook VBA Code  
Sub MailsInJahresOrdnerVerschieben()
    ' variablen  
    Dim fldrCurrent As folder, fldrDestinationRoot As folder, fldrDestination, mail As MailItem, moveCollection As New Collection, strYear As String
    ' quellordner zuweisen (anpassen)  
    Set fldrCurrent = Application.Session.Stores("user@domain.de").GetRootFolder.Folders("Amazon").Folders("Bestellungen").Folders("Aktuell")  
    ' Zielordner zuweisen (ohne Jahresordner) (anpassen)  
    Set fldrDestinationRoot = Application.Session.Stores("user@domain.de").GetRootFolder.Folders("Amazon").Folders("Bestellungen").Folders("Rest")  
    ' Jahr auf das aktuelle Jahr festlegen  
    strYear = CStr(Year(Date))
    On Error Resume Next
    Set fldrDestination = fldrDestinationRoot.Folders(strYear)
    ' Jahresordner anlegen wenn er nicht vorhanden ist  
    If fldrDestination Is Nothing Then
        Set fldrDestination = fldrDestinationRoot.Folders.Add(strYear)
        On Error GoTo 0
    End If
    ' mails des definierten Jahres in Collection hinzufügen  
    For Each mail In fldrCurrent.items
        ' Wenn das Jahr der Mail mit dem aktuellen übereinstimmt  
        If Year(mail.ReceivedTime) = strYear Then
            ' füge sie der Collection hinzu  
            moveCollection.Add mail
        End If
    Next
    ' wenn es Mails zum verschieben gibt  
    If moveCollection.Count > 0 Then
        ' verschiebe die Mails in den Jahres-Ordner  
        For Each mail In moveCollection
            mail.Move fldrDestination
        Next
    else
        MsgBox "Es gibt nichts zu Verschieben für dieses Jahr.", vbExclamation  
    End If
End Sub