Paramterabfrage mit vba ausführen

[jagger]

Hallo liebe Access-Gemeinde,

ich habe mal wieder ein Problemchen und brauche eure Hilfe.
Ich habe eine Abfrage "qry_SerienMailOutlook"

Code [Auswählen] Erweitern

SELECT IIf([Du]="ü","Hallo " & [Vorname],[Anrede] & " " & [Einkäufer]) AS DisplayName, "am " & [tDate] & " " & [tUm] & " " & [tTimeOn] & " " & [Location] AS OrderDate, tab_ex_Kundentelefone.Nummer AS Email
FROM ((tab_ex_Kunden LEFT JOIN tab_ex_kdnr ON tab_ex_Kunden.AGKDNR = tab_ex_kdnr.AGKDNR) LEFT JOIN tab_ex_Kundentelefone ON tab_ex_Kunden.AGKDNR = tab_ex_Kundentelefone.AGKDNR) LEFT JOIN (tab_ex_Termin LEFT JOIN tab_ex_Musterungsorte ON tab_ex_Termin.tLocation = tab_ex_Musterungsorte.Musterungsort) ON tab_ex_Kunden.AGKDNR = tab_ex_Termin.tAGKDNR
GROUP BY IIf([Du]="ü","Hallo " & [Vorname],[Anrede] & " " & [Einkäufer]), "am " & [tDate] & " " & [tUm] & " " & [tTimeOn] & " " & [Location], tab_ex_Kundentelefone.Nummer, tab_ex_Kunden.Plz, tab_ex_Kunden.Ort, tab_ex_Kunden.Strasse, tab_ex_Termin.tDate, tab_ex_Kunden.Terminbestaetigung
HAVING (((tab_ex_Kundentelefone.Nummer) Like "*@*") AND ((tab_ex_Kunden.Plz) Like [Formulare]![mnu_Kunden]![sfPLZ]) AND ((tab_ex_Kunden.Ort) Like [Formulare]![mnu_Kunden]![sfOrt]) AND ((tab_ex_Kunden.Strasse) Like [Formulare]![mnu_Kunden]![sfStrasse]) AND ((tab_ex_Termin.tDate) Between [Formulare]![frm_Export]![DatPickvon] And [Formulare]![frm_Export]![DatPickbis]) AND ((tab_ex_Kunden.Terminbestaetigung)="Mail"))
ORDER BY tab_ex_Kunden.Ort;

Nun möchte ich den Mailversand so wie hier https://codekabinett.com/rdumps.php?Lang=1&targetDoc=serien-email-access-vba-outlook-senden
beschrieben durchführen.

Da meine Abfrage mit Kriterien arbeitet, werden von Access Parameter erwartet.
Ich bekomme es einfach nicht hin

Code [Auswählen] Erweitern



Public Sub SendSerialEmail()

    Dim db As DAO.Database
    Dim rs As DAO.Recordset

    Dim emailTo As String
    Dim emailSubject As String
    Dim emailText As String
 
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT DisplayName, Orderdate, Email " & _
                                " FROM qry_SerienMailOutlook")
    Do Until rs.EOF

'... gekürzt



die Parameter zu übergeben.
Irgenwie muss da "Dim qdf As DAO.QueryDef" und "Set qdf = db.QueryDefs" und natürlich die "qdf.Parameters("[Forms]![mnu_Kunden]![sfPLZ]") = "rein, aber dann führte alle Experiment nur zu Fehlermeldungen.
"Parameter wurden erwartet" oder "Element in der Auflistung nicht gefunden"...

Wer kann mir hier bitte mal auf's Fahrrad helfen?

Mit bestem Dank!
LG
jagger

[markusxy]

Hier ein Link zum Umgang mit Parametern.

https://docs.microsoft.com/de-de/office/client-developer/access/desktop-database-reference/parameters-collection-dao

Bei einer Parameterabfrage die nur in VBA für ein Recordset verwendet wird, macht es keinen Sinn Formularbezüge zu verwenden, da die Angaben nicht aufgelöst werden.

Verwende also einfach normale sprechende Bezeichnungen und weise die Werte so wie im Beispiel zu.

OT: Die Abfrage ist grauenvoll. Aber das ist ja nicht das Thema.

[jagger]

Hallo marus888,

meinst Du das letzte Beispiel in von dem Link?
mit

Code [Auswählen] Erweitern

Set qdf = dbs.QueryDefs("SELECT DisplayName, Orderdate, Email " & _
                                " From qry_SerienMailOutlook")
Kommt die Fehlermeldung " Laufzeitfehler '3264' Element in dieser Auflistung nicht gefunden"

Was stimmt denn da nicht? "DisplayName, OrderDate, Email" sind in der Abfrage und die heißt "qry_SerienMailOutlook" 

LG
jagger

[Beaker s.a.]

Hallo Jagger,
Das fehlende Element ist der Name der Abfrage.
Die Auflistung .QueryDefs enthält nur die gespeicherten Abfragen.
Nimm

Code [Auswählen] Erweitern

Set qdf = dbs.CreateQueryDef("temp", "SELECT DisplayName, Orderdate, Email " & _
                                " From qry_SerienMailOutlook")

gruss ekkehard

[jagger]

Hallo Ekkehard,

Danke für Deinen guten Tipp! Für alle hier mal der funktionierende Code.

Public Sub OutlookSerieSendTermin()
   Dim QPLZ As String 'Parameters
   Dim QOrt As String  'Parameters
          QPLZ = Forms![mnu_Kunden]![sfPLZ] 'Parameters
          QOrt = Forms![mnu_Kunden]![sfOrt] 'Parameters

    Dim emailTo As String
    Dim emailSubject As String
    Dim emailText As String
       
    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    Dim outlookStarted As Boolean
       
    Dim GFLG As String
    Dim GFName As String
    GFLG = Nz(DLookup("GrussformelLG", "tab_intex_Daten", ""))
    GFName = Nz(DLookup("GrussformelName", "tab_intex_Daten", ""))
   
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If outApp Is Nothing Then
        Set outApp = CreateObject("Outlook.Application")
        outlookStarted = True
    End If

    Set db = CurrentDb()
    Set qdf = db.CreateQueryDef("", "SELECT DisplayName, Orderdate, Email" & _
                                " From qry_SerienMailOutlook")
    qdf.Parameters("[Formulare]![mnu_Kunden]![sfPLZ]") = QPLZ 'Parameters
    qdf.Parameters("[Formulare]![mnu_Kunden]![sfOrt]") = QOrt 'Parameters

   Set rs = qdf.OpenRecordset(dbOpenDynaset)

Do Until rs.EOF
   emailTo = rs.Fields("DisplayName").Value & " <" & rs.Fields("Email").Value & ">"
   emailSubject = "unser nächster Termin: " & rs.Fields("Orderdate").Value
   emailText = rs.Fields("DisplayName").Value & "," & vbCrLf & vbCrLf & "unser nächster Kollektionsvorlage-Termin" & vbCrLf & "ist " & rs.Fields("Orderdate").Value & "." & vbCrLf & "Eine gute Anreise und bis bald" & vbCrLf & vbCrLf & GFLG & vbCrLf & GFName
                     
        Set outMail = outApp.CreateItem(olMailItem)
        outMail.To = emailTo
        outMail.subject = emailSubject
        outMail.body = emailText
        outMail.Send

        rs.MoveNext
    Loop
   
    rs.Close
    Set rs = Nothing
    Set db = Nothing
   
    If outlookStarted Then
        outApp.Quit
    End If
   
    Set outMail = Nothing
    Set outApp = Nothing
   
End Sub

Wichtig war hier (in diesem speziellen Fall)
Set qdf = db.CreateQueryDef("", "SELECT DisplayName, Orderdate, Email  From qry_SerienMailOutlook")

Damit wird die Abfrage gar nicht erst gespeichert und man muss sie nicht löschen.

Vielen Dank für die Mithilfe!

LG
jagger