Hallo, ich bin absoluter VBA-Laie und habe da eine Frage.
Ich habe einen VBA -Code mit dem in eine Email an ausgewählte Schüler versenden kann.
Funktioniert auch soweit gut. Im Email-Text habe ich eine Variable angegeben, die den Lehrer angibt. Nun möchte ich eine Dlookup-Funktion verwenden, die mir den entsprechenden Lehrer in aus meine "qryEmailBenachrichtigung"-Abfrage angibt.
Die Funktion ist:
VarLehrer1 = DLookup("lhrVorrname", "tblLehrer", "lhrID =" & DLookup("Lehrer1Ref", "qryEmailBenachrichtigung", "CurrentRecord?????"))
Da diese Funktion in einem Loop eingebunden ist, der Datensatz für Datensatz in der "qryEmailBenachrichtigung"- Abfrage durchläuft,
möchte ich gerne als Kriterium einfach "Aktueller Datensatz" angeben.
Die Query sieht so aus:
SchülerName / EmailAdress / Sein Lehrer /...
Hans hans@gmail. Tom
Anna anna@gmx. Daniel
....
Kann mir jemand sagen, wie das funktioniert?
Hoffe ich war verständlich
MfG
Marcello Thiel
Hallo,
sorry, das ist überhaupt nicht verständlich..
Zitat...einen VBA -Code ...
Dann zeig den doch mal.
ZitatIm Email-Text habe ich eine Variable angegeben, die den Lehrer angibt.
??
Zitat...mir den entsprechenden Lehrer in aus meine "qryEmailBenachrichtigung"-Abfrage ...
den "Lehrer" hast Du schon .. ??
Oder willst Du den Vornamen des Lehrers ermitteln?
Das
ZitatDLookup("lhrVorrname", "tblLehrer", "lhrID ="...
sieht jedenfalls so danach aus.
Den kargen (und falschen) Angaben entsprechend könnte das so aussehen:
VarLehrer1 = DLookup("[Sein Lehrer]", "qryEmailBenachrichtigung", "EmailAdress ='" & RS!EmailAdress & "'")-- zeige den kompletten Code der betreffenden Prozedur
-- zeige den SQL-String der Abfrage(n)
-- zeige den Screenshot des Beziehungsfensters.
Ok, sorry ich versuch's nochmal:
In der Abfrage werden die Schüler herausgefiltert, an die eine E-Mail versendet werden soll, inklusive ihrer E-Mail-Adresse, dem Kurs, den sie besuchen, den Lehrern, die sie haben und dem Raum, in dem sie Unterricht haben werden. Diese Abfrage habe ich als SQL-Satement in den VBA Code eingebettet. Nun läuft dieser Record für record durch und versendet eine Mail. Nur fehlt mir in den Dlookup funktionen für Lehrer1 u. Lehrer ein Kriterium welches irgendwie lauten soll: "In CUrrent Record". Wahrscheinlich geht es auch ganz anders über eine SQL-Anweisung, wie ich das für den Raum gemaht habe. Oder man könnte eine irgendwie Auto-ID in die Abfrage einbauen und sich dann auf diese beziehen. Mit allen Ansätzen bin ich aber bisher gescheitert und weiß einfach nicht weiter. Hab mir bis jetzt halt alles selbst beigebracht.
Im Anhang noch 2 Screenshots
Vielen Dank schon mal
Marcello
Hier der VBA Code:
Private Sub Befehl358_Click()
'Der Code stammt von http://www.codekabinett.com/rdumps.php?Lang=1&targetDoc=serien-email-access-vba-outlook-senden
Dim db As DAO.Database
Dim rs As DAO.Recordset
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 varBeginndatum As Date
Dim VarRaum As Integer
Dim VarLehrer1 As String
Dim VarLehrer2 As String
Dim VarKursende As Date
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 rs = db.OpenRecordset("SELECT tblKursteilnehmer.ktnFamilienName, tblKursteilnehmer.ktnVorname, tblKursteilnehmer.ktnEmail, tblKurse.kurKNR, tblKurse.Lehrer1Ref, tblKurse.Lehrer2Ref, tblKurse.kurRaumzuweisungRef" & _
" FROM sqryFolgeKursperiode, tblKurstypen INNER JOIN (tblKurstermine INNER JOIN (tblKursteilnehmer INNER JOIN (tblKurse INNER JOIN tblZahlungenKurse ON tblKurse.kurID = tblZahlungenKurse.zlgkurkurIDRef) ON tblKursteilnehmer.ktnTNNR = tblZahlungenKurse.zlgktnTNNRRef) ON tblKurstermine.ktmID = tblKurse.kurKursTermineRef) ON tblKurstypen.ktpNR = tblKurse.kurKurstypenRef" & _
" WHERE (((tblKurstypen.ktpKursKategorie)<>6 And (tblKurstypen.ktpKursKategorie)<>7 And (tblKurstypen.ktpKursKategorie)<>8) AND ((tblKurstermine.ktmKursperiode)=[sqryFolgeKursperiode]![Naechste Periode]) AND ((tblZahlungenKurse.zlgWarteplatz)=False));")
'SQL Anweisung für qryEmailBenachrichtigung, die auswählt an welche Schüler eine Email versendet werden soll.
VarKursende = DLookup("ktmKursende", "sqryaktuelleKursperiode", "") 'Allgemeingültig, daher ohne Kriterium, am ANfang
Do Until rs.EOF
If DLookup("ktpKursKategorie", "qryEmailBenachrichtigung", "") = 4 Then varBeginndatum = DateAdd("d", 1, DLookup("ktmKursbeginn", "sqryFolgeKursperiode", "")) Else varBeginndatum = DLookup("ktmKursbeginn", "sqryFolgeKursperiode", "") 'If not Abendkusrs then NachsteKurs Beginndatum
VarRaum = rs.Fields("kurRaumzuweisungRef").Value 'Es Fehlen noch Kriterien um zu sagen, Dlookup im aktuellen Datensatz
VarLehrer1 = DLookup("lhrVorrname", "tblLehrer", "lhrID =" & DLookup("Lehrer1Ref", "qryEmailBenachrichtigung", "Record =" & CurrentRecord))
VarLehrer2 = Nz(DLookup("lhrVorrname", "tblLehrer", "lhrID =" & DLookup("Lehrer2Ref", "qryEmailBenachrichtigung", "")), "")
' Bei DI/DO Kursen wird dem BEginndatum +1Tag hinzugefügt (FUnktioniert nur, wenn in der QRY das Feld Kurstyp angezeigt wird!)
If IsNull(rs.Fields("ktnEmail").Value) Then
rs.MoveNext
' Diesen Teil habe ich hinzugefügt, damit einfach weitergemacht wird, wenn es keine Emailadresse gibt
Else
emailTo = Trim(rs.Fields("ktnVorname").Value & " " & rs.Fields("ktnFamilienName").Value) & _
" <" & rs.Fields("ktnEmail").Value & ">"
emailSubject = "Deine Sprachschule - Zentrum für deutsche Sprache und Kultur"
emailText = "Hallo," & vbCrLf & "nicht vergessen: ab " & varBeginndatum & " hast du Unterricht in Raum " & VarRaum & " mit " & VarLehrer1 & " und " & VarLehrer2 & _
"." & vbCrLf & "Bitte zahl noch deinen Kurs bis spätestens " & VarKursende & ", falls du es noch nicht getan hast." & vbCrLf & "Deine Sprachschule"
'IF Kurstyp = 4 then nicht Lehrer2 schreiben!
Set outMail = outApp.CreateItem(olMailItem)
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Send
rs.MoveNext
End If
Loop
rs.Close
If outlookStarted Then
outApp.Quit
End If
Set rs = Nothing
Set db = Nothing
Set outMail = Nothing
Set outApp = Nothing
VarKursende = Empty ' Warum auch immer hat hier Nothing nicht funktioiert
varBeginndatum = Empty
VarRaum = Empty
VarLehrer1 = Empty
VarLehrer2 = Empty
End Sub
Achso der SQL CODE sieht so aus:
SELECT tblKursteilnehmer.ktnFamilienName, tblKursteilnehmer.ktnVorname, tblKursteilnehmer.ktnEmail, tblKurse.kurKNR, tblKurse.Lehrer1Ref, tblKurse.Lehrer2Ref, tblKurse.kurRaumzuweisungRef, tblKurstypen.ktpKursKategorie
FROM sqryFolgeKursperiode, tblKurstypen INNER JOIN (tblKurstermine INNER JOIN (tblKursteilnehmer INNER JOIN (tblKurse INNER JOIN tblZahlungenKurse ON tblKurse.kurID = tblZahlungenKurse.zlgkurkurIDRef) ON tblKursteilnehmer.ktnTNNR = tblZahlungenKurse.zlgktnTNNRRef) ON tblKurstermine.ktmID = tblKurse.kurKursTermineRef) ON tblKurstypen.ktpNR = tblKurse.kurKurstypenRef
WHERE (((tblKurstypen.ktpKursKategorie)<>6 And (tblKurstypen.ktpKursKategorie)<>7 And (tblKurstypen.ktpKursKategorie)<>8) AND ((tblKurstermine.ktmKursperiode)=[sqryFolgeKursperiode]![Naechste Periode]) AND ((tblZahlungenKurse.zlgWarteplatz)=False));
Und den Lehrer habe ich natürlich schon. Ich möchte den Vornamen des Lehrers für den entsprechenden Datensatz ermitteln.
MfG
Marcello
Hallo,
(alles ungetestet und ohne Errorhandler!)
Private Sub Befehl358_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
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 datBeginndatum As Date
Dim lngRaum As Long
Dim strLehrer1 As String
Dim strLehrer2 As String
Dim datKursende As Date
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 rs = db.OpenRecordset("SELECT tblKursteilnehmer.ktnFamilienName, tblKursteilnehmer.ktnVorname, tblKursteilnehmer.ktnEmail, tblKurse.kurKNR, tblKurse.Lehrer1Ref, tblKurse.Lehrer2Ref, tblKurse.kurRaumzuweisungRef" & _
" FROM sqryFolgeKursperiode, tblKurstypen INNER JOIN (tblKurstermine INNER JOIN (tblKursteilnehmer INNER JOIN (tblKurse INNER JOIN tblZahlungenKurse ON tblKurse.kurID = tblZahlungenKurse.zlgkurkurIDRef) ON tblKursteilnehmer.ktnTNNR = tblZahlungenKurse.zlgktnTNNRRef) ON tblKurstermine.ktmID = tblKurse.kurKursTermineRef) ON tblKurstypen.ktpNR = tblKurse.kurKurstypenRef" & _
" WHERE (((tblKurstypen.ktpKursKategorie)<>6 And (tblKurstypen.ktpKursKategorie)<>7 And (tblKurstypen.ktpKursKategorie)<>8) AND ((tblKurstermine.ktmKursperiode)=[sqryFolgeKursperiode]![Naechste Periode]) AND ((tblZahlungenKurse.zlgWarteplatz)=False));")
'SQL Anweisung für qryEmailBenachrichtigung, die auswählt an welche Schüler eine Email versendet werden soll.
datKursende = DLookup("ktmKursende", "sqryaktuelleKursperiode", "") 'Allgemeingültig, daher ohne Kriterium, am ANfang
Do Until rs.EOF
If DLookup("ktpKursKategorie", "qryEmailBenachrichtigung", "") = 4 Then
datBeginndatum = DateAdd("d", 1, DLookup("ktmKursbeginn", "sqryFolgeKursperiode", ""))
Else
datBeginndatum = DLookup("ktmKursbeginn", "sqryFolgeKursperiode", "")
End If
'If not Abendkusrs then NachsteKurs Beginndatum
lngRaum = rs!kurRaumzuweisungRef
'Es Fehlen noch Kriterien um zu sagen, Dlookup im aktuellen Datensatz
strLehrer1 = Nz(DLookup("LhrVorrname", "tblLehrer", "lhrID =" & Rs!Lehrer1Ref),"")
strLehrer2 = Nz(DLookup("LhrFamilienname", "tblLehrer", "lhrID =" & Rs!Lehrer1Ref),"")
' Bei DI/DO Kursen wird dem BEginndatum +1Tag hinzugefügt (FUnktioniert nur, wenn in der QRY das Feld Kurstyp angezeigt wird!)
If IsNull(rs.Fields("ktnEmail")) Then
rs.MoveNext
Else
emailTo = Trim(rs.Fields("ktnVorname").Value & " " & rs.Fields("ktnFamilienName").Value) & _
" <" & rs.Fields("ktnEmail").Value & ">"
'''' emailTo = Cstr(rs!ktnEmail) 'reicht doch...
emailSubject = "Deine Sprachschule - Zentrum für deutsche Sprache und Kultur"
emailText = "Hallo," & vbCrLf & " nicht vergessen: ab " & datBeginndatum & " hast du Unterricht in Raum " & lngRaum & " mit " & strLehrer1 & " und " & strLehrer2 & _
"." & vbCrLf & " Bitte zahl noch deinen Kurs bis spätestens " & datKursende & ", falls du es noch nicht getan hast." & vbCrLf & "Deine Sprachschule"
'IF Kurstyp = 4 then nicht Lehrer2 schreiben!
Set outMail = outApp.CreateItem(olMailItem)
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
''outMail.Send
outMail.Display 'erst testen/anzeigen
rs.MoveNext
End If
Loop
rs.Close
If outlookStarted Then
outApp.Quit
End If
Set rs = Nothing
Set db = Nothing
Set outMail = Nothing
Set outApp = Nothing ' Nothing funktioniert nur bei Objekt-Variablen (Set X = ...)
datKursende = 0 ' alle anderen Variablen entspr. ihrem Datentyp setzen. Ist am Ende einer Prozedur überflüssig, weil sowieso "zerstört".
datBeginndatum = 0
lngRaum =0
strLehrer1 = ""
strLehrer2 = ""
End Sub
Heurekaaaa! Es hat funktioniert.
Das war genau das, was ich gesucht habe: "lhrID =" & Rs!Lehrer1Ref
Perfekt! Tausend Dank!