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!!!
|