Hallo zusammen!

Ich bin mit meinem Latein am Ende und habe schon alle Beschreibungen zu diesem Fehler ausprobiert. Ziel der Access-Applikation ist, allen gespeicherten 1200 Usern eine Email zu schreiben mit einem PDF im Anhang (wird von einem Access-Report generiert).

Folgende Funktionselektiert alle User und startet den Hauptprozess:

Dim strSQL As String
    Dim strCondition As String
    Dim strReportName As String
    Dim intMissingEmails As Integer
    Dim strPDFDest As String
    Dim strSubject As String
    Dim strDatum As Date
    Dim strCountRows As String
    
    '-- Destination für das temporäre PDF File
    strPDFDest = CurrentProject.path & "\reporttopdf\Profil_Check.pdf"
    
    strReportName = "ber-pma-einzelblatt-check"
    strSubject = "Your subject"
    strDatum = Date
    
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    Set db = CurrentDb
    
    '--- Alle aktiven User selektieren (rund 1200)
    strSQL = "SELECT [tab-pma].[PMA-NR], [tab-pma].Email, [tab-pma].NamePMA, [tab-pma].VornamePMA, [tab-pma].[PMA-Kat]" & _
        " From [tab-pma] " & _
        " WHERE ((([tab-pma].Email) Is Not Null) And (([tab-pma].[PMA-Kat]) = 1)) And ((([tab-pma].Email) <> '')) " & _
        " ORDER BY [tab-pma].[PMA-NR]"
    
    Set rs = db.OpenRecordset(strSQL)
    
    rs.MoveFirst

    Do While Not rs.EOF
    
        '--- Report löschen falls bereits vorhanden
        If FileExistsFSO(strPDFDest) Then
            Kill strPDFDest
        End If

        strCondition = " [PMA-NR] = " & rs![PMA-NR]

        Call SetReportFilter(strReportName, strCondition)

        '--- Report generieren, auskommentiert zum Testen
        'If (ConvertReportToPDF("ber-pma-einzelblatt-check", vbNullString, strPDFDest, False, False, 150, "", "", 0, 0, 0) = False) Then
        '    MsgBox "Failed to create PDF File. Please contact your administrator."
        '    Exit Sub
        'End If

        If (IsNull(rs![Email]) Or rs![Email] = "") Then
            intMissingEmails = intMissingEmails + 1
        Else
            '--- Email öffnen und versenden
            SendMailCheck "email@email.de", strSubject, strPDFDest, rs![NamePMA], rs![VornamePMA]
        End If
    
        rs.MoveNext

    Loop
    
    rs.Close

Diese Schleife funktioniert soweit. Das Problem liegt meiner Meinung nach in der Funktion SetReportFilter, dort geht der Debugger auch zur Zeile DoCmd.Save acREport, pReportName. 

Sub SetReportFilter(pReportName, pFilter)
    
    Dim rpt As Report
    
    DoCmd.OpenReport pReportName, acViewDesign
    Set rpt = Reports(pReportName)
    rpt.Filter = pFilter
    rpt.FilterOn = True
    
    DoCmd.Save acReport, pReportName
    DoCmd.Close acReport, pReportName
    
    Set rpt = Nothing
End Sub

Die Schleife wird abgearbeitet und funktioniert bis sich 461 Email im Postausgang befinden. Dann wird mit dem Fehler "Laufzeitfehler 3709: Der Suchschlüssel wurde in keinem Datensatz gefunden." abgebrochen, der Report bleibt offen. Ich habe die Datenbank bereits überprüft, neu importiert, komprimiert etc. Habe die Datensätze in diesem Bereich auch schon gelöscht, bricht immer nach 461 Emails ab. Sieht jemand den vielleicht offensichtlichen Fehler im Code, den ich nicht entdecken kann? Hatte jemand einmal ein ähnliches Problem?

Bin um jede Hilfe dankbar!!!