Outlook VBA - Jede 10. Mail verschieben

''' Je Ordner ein Sub Aufruf  
''' Teil 1  
Sub VerschiebeInGelesen()
    VerschiebeEMail ("\\<Postfachname>\Posteingang\<Zielordner>")  
End Sub

''' Verschiebt E-Mails in einen Zielordner  
''' Die Pfadangabe aus Outlook kopieren  
''' Teil 2  
Sub VerschiebeEMail(ZielOrdner As String)
    Dim strOutlookFolderPath As String
    Dim oulAusgewaehlte As Outlook.Selection
    Dim intZähler As Integer
    Dim strOutlookMAPIFolders() As String
    Dim mapFld As MAPIFolder
    
    Set oulAnwendung = CreateObject("Outlook.Application")  
    Set oulAusgewaehlte = oulAnwendung.ActiveExplorer.Selection
    
    strOutlookFolderPath = ZielOrdner
    strOutlookMAPIFolders = GetOutlookMapiFolder(strOutlookFolderPath)
    Set mapFld = GetOutlookMapiObject(strOutlookMAPIFolders)
       
    For intZähler = 1 To oulAusgewaehlte.Count
        oulAusgewaehlte.Item(intZähler).UnRead = False
        oulAusgewaehlte.Item(intZähler).Move mapFld
    Next intZähler
End Sub