Using nested loops to email a list of daily jobs to each recipient

Question

I've been dabbling with VBA in Access for years, but to be honest I've never really used RecordSets before.

I have a SQL string which will create a list of all engineer's visits for a specific day:

"SELECT Cases.Id, Customers.SiteName, tbl_Visits.[Visit Date], Employees.[Last Name],     Employees.[Job Title], Employees.[E-mail Address] " & vbCrLf & _
"FROM (Customers INNER JOIN Cases ON Customers.ID = Cases.Customer) INNER JOIN (Employees INNER JOIN tbl_Visits ON Employees.ID = tbl_Visits.Engineer) ON Cases.Id = tbl_Visits.CaseID " & vbCrLf & _
"WHERE (((tbl_Visits.[Visit Date])=#1/27/2014#) AND ((Employees.[Job Title])=""Engineer""));"

I'm going to replace the fixed date with a variable, which works well on another RecordSet I use.

What I want to do with this data is create a text string of ID, Site name, visit date for each email address, and then send that as an email. I can do the email bit, and I could send the whole RecordSet as one email text string, I'm just stuck with sending as many emails as there are email addresses.

I have a feeling it'll be a "for each" job, but I really don't know.

Answer 1

You're on the right track. All you need to do is leverage the fact that an Access query can not only be based on tables, it can also use other saved queries in the same way.

So if you create a "saved query" (technically called a QueryDef object) named [dailyVisits] using your SQL string in VBA code like this

Dim qdf As DAO.QueryDef
Set qdf = CurrentDb.CreateQueryDef("dailyVisits", _
        "SELECT Cases.Id, Customers.SiteName, tbl_Visits.[Visit Date], Employees.[Last Name],     Employees.[Job Title], Employees.[E-mail Address] " & vbCrLf & _
        "FROM (Customers INNER JOIN Cases ON Customers.ID = Cases.Customer) INNER JOIN (Employees INNER JOIN tbl_Visits ON Employees.ID = tbl_Visits.Engineer) ON Cases.Id = tbl_Visits.CaseID " & vbCrLf & _
        "WHERE (((tbl_Visits.[Visit Date])=#1/27/2014#) AND ((Employees.[Job Title])=""Engineer""));"
Set qdf = Nothing

Then you can use nested loops to

1. extract the distinct set of e-mail addresses,
2. create the site information strings for each one, and send via e-mail

using VBA code something like this:

Dim rstEmail As DAO.RecordSet, rstVisits As DAO.RecordSet, VisitList As String
Set rstEmail = CurrentDb.OpenRecordset( _
        "SELECT DISTINCT [E-mail Address] FROM dailyVisits", _
        dbOpenSnapshot)
Do Until rstEmail.EOF
    Set rstVisits = CurrentDb.OpenRecordset( _
            "SELECT Id & ", " & SiteName & ", " & [Visit Date] AS Visit " & _
            "FROM dailyVisits " & _
            "WHERE [E-mail Address] = '" & rstEmail![E-mail Address] & "'",
            dbOpenSnapshot)
    VisitList = ""
    Do Until rstVisits.EOF
        VisitList = VisitList & rstVisits!Visit & VbCrLf
        rstVisits.MoveNext
    Loop
    rstVisits.Close
    Set rstVisits = Nothing
    '
    ' insert code to send VisitList to rstEmail![E-mail Address]
    '
    rstEmail.MoveNext
Loop
rstEmail.Close
Set rstEmail = Nothing
DoCmd.DeleteObject acQuery, "dailyVisits"

Answer 2

Thanks so much for your help. After not very much messing around, I've settled on:

    Dim rstEmail As DAO.Recordset, rstVisits As DAO.Recordset, VisitList As String, eml2txt As String, sql2 As String

Dim OutApp As Object
    Dim OutMail As Object

 Dim qdf As DAO.QueryDef
Set qdf = CurrentDb.CreateQueryDef("qryEngJobList1", _
    "SELECT Cases.Id, Customers.SiteName, Customers.[Post Code] AS PCode, tbl_Visits.[Visit Date] AS vDate, Employees.[Last Name] AS lname, Employees.[Job Title], Employees.[E-mail Address] AS dEmail " & vbCrLf & _
    "FROM Employees INNER JOIN (Customers INNER JOIN (Cases INNER JOIN tbl_Visits ON Cases.Id = tbl_Visits.CaseID) ON Customers.ID = Cases.Customer) ON Employees.ID = tbl_Visits.Engineer " & vbCrLf & _
    "WHERE (((tbl_Visits.[Visit Date])=" & SQLDate([TempVars]![senddate].[Value]) & ") AND ((Employees.[Job Title])=""Engineer""));")
Set qdf = Nothing


Set rstEmail = CurrentDb.OpenRecordset( _
        "SELECT DISTINCT [dEmail] FROM qryengjoblist1", _
        dbOpenSnapshot)
Do Until rstEmail.EOF
    Set rstVisits = CurrentDb.OpenRecordset( _
            "SELECT Id, SiteName, vDate, PCode " & _
            "FROM qryengjoblist1 " & _
            "WHERE dEmail = '" & rstEmail![dEmail] & "'", _
            dbOpenSnapshot)
    VisitList = ""
    Do Until rstVisits.EOF
        VisitList = VisitList & rstVisits!ID & vbTab & rstVisits!SiteName & vbTab & rstVisits!PCode & vbCrLf
        rstVisits.MoveNext
    Loop
    rstVisits.Close
    Set rstVisits = Nothing
    '
    ' insert code to send VisitList to rstEmail![E-mail Address]

    eml2txt = "Please find below your visit summary for " & TempVars!senddate & ":" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "" _
   & VisitList & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "" _
   & "If there are any issues, please contact " & TempVars!sereml & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "" _
   & "Thank you."



    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .SentOnBehalfOfName = TempVars!sereml
        .To = rstEmail!dEmail
        .CC = TempVars!sereml
        .BCC = ""
        .Subject = "Job Summary for " & TempVars!senddate
        .Body = eml2txt
        .Display   'or use .Send
        .ReadReceiptRequested = False
    End With
    On Error GoTo 0

    'MsgBox eml2txt
    '
    rstEmail.MoveNext
Loop
rstEmail.Close
Set rstEmail = Nothing

DoCmd.DeleteObject acQuery, "qryengjoblist1"


End Sub

Which seems to be doing the trick nicely. All I've got to do now is figure out how go give you a thanks or something on here :)