Alle Mails aus verzeichnis versenden, diese aber zu je 10 Mails senden und verschieben

' maximale Anzahl an Anlagen pro Mail  
    Const MAXATTACH = 10
    ' Ordner mit den Attachments  
    Const ATTACHMENTFOLDER = "C:\temp\blaAnträge"  
    ' Archivordner  
    Const ARCHIVEFOLDER = "c:\temp\versendet_bla_Anträge"  
    ' Suchwort für Dateien  
    Const SEARCHTERM = "bla-Antrag"  
    '--------------------------  
    ' counter für Attachments  
    Dim cnt As Integer: cnt = 0
    Dim colAttachments As Collection
    
    ' Filesystemobject  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    'Neue Mail nach Vorgabe erstellen  
    Set mail = CreateMailTemplate
    ' Attachments suchen ...  
    Set colAttachments = SearchFilesInFolder(ATTACHMENTFOLDER, SEARCHTERM)
    'Wenn Attachments da ...  
    
    
    If colAttachments.Count > 0 Then
        ' Für jedes Attachment  
        For Each File In colAttachments
            ' Wenn max. Attachment-Anzahl erreicht zeige mail und erstelle eine neue  
            If cnt > 0 And (cnt Mod MAXATTACH) = 0 Then
                mail.Display
                Set mail = CreateMailTemplate
            End If
            'Attachment hinzufügen  
            mail.Attachments.Add File
            'counter erhöhen  
            cnt = cnt + 1
        Next
        ' Mail Anzeigen  
        mail.Display
        
        ' Dateien in Archivordner verschieben  
        For Each File In colAttachments
            'Prüfen ob Dateiname der Vorgabe entspricht  xxxxxxxx_xxxxxxx_bla-Antrag_xxxxxxx  
             Dim Txt(1) As String
             Dim i As Long
             Dim Match As Boolean
             Set Re = CreateObject("VBScript.RegExp")  
             Re.MultiLine = True
             Re.pattern = "\d{8}_\d{7}_bla-Antrag_"  


                Txt(1) = Right(File, (Len(File) - (Len(ATTACHMENTFOLDER) + 1)))


                For i = 1 To 1
                Match = Re.test(Txt(i))
                     If Match Then
                     fso.MoveFile File, ARCHIVEFOLDER & "\"  
                 Else
                     Debug.Print (File), " ---> Fehler, nicht verschoben"  
                     End If
                Next
                     
        
            
        Next
            myDebug (File) & " ---> bitte das temp. Verzeichnis auf weitere nicht versendete Dateien prüfen und bei bedarf umbenennen."  

    Else
        ' Keine Attachments gefunden  
        MsgBox "Keine Attachments für Suchwort gefunden!", vbExclamation  
    End If
    'Cleanup  
    Set fso = Nothing
End Sub