Dezember 05, 2021, 05:54:54

Neuigkeiten:

Wenn ihr euch für eine gute Antwort bedanken möchtet, im entsprechenden Posting einfach den Knopf "sag Danke" drücken!


Recordset aus gefilterter Abfrage öffnen

Begonnen von brueninghoff, August 05, 2021, 09:53:55

⏪ vorheriges - nächstes ⏩

DF6GL

Hallo,

ZitatAnd Year([QRY_Sped-Frachtdaten].Mon) = " & Me!Txt_Jahr & " And Month([QRY_Sped-Frachtdaten].Mon) = " & Me!Txt_Monat & " " & _


was soll das nun wieder ?

brueninghoff

Hallo,

sorry der letzte Code war aus einer falschen Datenbankversion, bin da mit der Versionierung etwas durcheinander gekommen.

konnte dank eurer Hilfe das Problem nun beheben

hier noch der Code:

Private Sub CMD_Datenversand_Click()
On Error GoTo Err_EMailVersandAbgebrochen 'Routine zum Abfangen von Fehlern und Abbruch des Benutzers

    'Variablen definieren
    Dim QRY_Fracht As String
    Dim db As DAO.Database
    Dim rs_Fracht As DAO.Recordset
    Dim REPname As String
    Dim REPfilter As String
    Dim ATTname As String
    Dim SUBJ As String
    Dim BDY As String
    Dim Datemonth As String
   
    If Len(Me!Txt_Monat) = 1 Then
        Datemonth = "0" & Me!Txt_Monat
    Else
        Datemonth = Me!Txt_Monat
    End If
   
    REPname = "REP_Frachtdaten" 'Report für die Auswertung
   
    Set db = CurrentDb()
    QRY_Fracht = "SELECT [QRY_Sped-Frachtdaten].AL20_SUCHNAME, [QRY_Sped-Frachtdaten].AL21_EMAIL, [QRY_Sped-Frachtdaten].VK30_NR, [QRY_Sped-Frachtdaten].Mon " & _
                "FROM [QRY_Sped-Frachtdaten] " & _
                "WHERE [QRY_Sped-Frachtdaten].VK30_NR <> 90010 And [QRY_Sped-Frachtdaten].Mon = '" & Me!Txt_Jahr & "/" & Datemonth & "' " & _
                "GROUP BY [QRY_Sped-Frachtdaten].AL20_SUCHNAME, [QRY_Sped-Frachtdaten].AL21_EMAIL, [QRY_Sped-Frachtdaten].VK30_NR, [QRY_Sped-Frachtdaten].Mon;"
    'MsgBox QRY_Fracht
    Set rs_Fracht = db.OpenRecordset(QRY_Fracht) 'Recordset öffnen
    If rs_Fracht.EOF Then 'Wenn keine Einträge vorhanden sind
        MsgBox "Keine Addressaten gefunden!"
        Exit Sub
    End If
    BDY = "Sehr geehrte Damen und Herren" & vbCrLf & vbCrLf & "Anbei erhalten Sie die Auswertung der Milchlieferungen für den im Betreff genannten Zeitraum." 'Mailbody erzeugen
                   
    Do Until rs_Fracht.EOF 'Für jeden Datensatz im Recordset
        REPfilter = "VK30_NR = " & rs_Fracht!VK30_NR & " And Mon = '" & rs_Fracht!Mon & "'" 'Filterparameter für den Report erneut setzen"
        DoCmd.OpenReport REPname, acViewPreview, "", REPfilter, acHidden 'Öffne den Report
       
        ZielEmail = Reports!REP_Frachtdaten!TXT_MAIL.Value ' ''Adresse beziehen
       
        SUBJ = "Kälbermilch-Frachtdaten" & " " & Reports!REP_Frachtdaten!TXT_MON.Value 'Titel generieren
        ATTname = "Kälbermilch-Frachtdaten" & " " & rs_Fracht!AL20_SUCHNAME 'Name des Attachments
        Reports(REPname).Caption = ATTname 'Titel des Reports neu setzen

        DoCmd.SendObject acReport, REPname, "PDF", ZielEmail, , , SUBJ, BDY, False, "" 'Mail automatisch versenden (Outlook Warnung bestätigen)
       
        DoCmd.Close acReport, REPname 'aktiven Report wieder schließen
                   
        rs_Fracht.MoveNext 'Nächster Datensatz im Recordset
    Loop
       
    rs_Fracht.Close 'Recordset schließen
    Set rs_Fracht = Nothing
    Set db = Nothing
   
Exit Sub 'Bei sauberem Verlauf (Email wurde gesendet, kein Abbruch) oder wenn der notwendige Parameter fehlt, verlasse die Subroutine vorzeitig

    'Bei Abbruch durch den Benutzer Fehler 2501 Meldung ausgeben oder Fehler-Nummer
Err_EMailVersandAbgebrochen:
    If Err.Number = 2501 Then
        MsgBox "Die E-Mail wurde nicht gesendet.", vbCritical + vbOKOnly
    Else
        MsgBox "Fehler " & Err.Number & ":" & Err.Description
    End If
   
    rs_Fracht.Close 'Recordset schließen
    Set rs_Fracht = Nothing
    Set db = Nothing

End Sub

Vielen dank!