Hallo liebe Access-Gemeinde,
ich habe mal wieder ein Problemchen und brauche eure Hilfe.
Ich habe eine Abfrage "qry_SerienMailOutlook"
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 (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
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
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.
Hallo marus888,
meinst Du das letzte Beispiel in von dem Link?
mit
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" :o
LG
jagger
Hallo Jagger,
Das fehlende Element ist der Name der Abfrage.
Die Auflistung .QueryDefs enthält nur die gespeicherten Abfragen.
Nimm
Set qdf = dbs.CreateQueryDef("temp", "SELECT DisplayName, Orderdate, Email " & _
" From qry_SerienMailOutlook")
gruss ekkehard
Hallo Ekkehard,
Danke für Deinen guten Tipp! Für alle hier mal der funktionierende Code.
Zitat
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