使用嵌套循环将日常工作列表通过电子邮件发送给每个收件人

Question

多年来，我一直在 Access 中使用 VBA，但老实说，我以前从未真正使用过 RecordSet。

我有一个 SQL 字符串，它将创建一个特定日期所有工程师访问的列表：

"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""));"

我将用一个变量替换固定日期，这在我使用的另一个 RecordSet 上效果很好。

我想要对这些数据执行的操作是为每个电子邮件地址创建一个包含 ID、站点名称、访问日期的文本字符串，然后将其作为电子邮件发送。我可以处理电子邮件，我可以将整个 RecordSet 作为一个电子邮件文本字符串发送，我只是坚持发送与电子邮件地址一样多的电子邮件。

我感觉这将是“每个人”的工作，但我真的不知道。

Answer 1

你在正确的轨道上。您需要做的就是利用这样一个事实，即 Access 查询不仅可以基于表，还可以以相同的方式使用其他已保存的查询。

因此，如果您在 VBA 代码中使用 SQL 字符串创建一个名为 [dailyVisits] 的“已保存查询”（技术上称为 QueryDef 对象），如下所示

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

然后你可以使用嵌套循环来

1. 提取不同的电子邮件地址集，
2. 为每一个创建站点信息字符串，并通过电子邮件发送

使用类似这样的 VBA 代码：

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

非常感谢您的帮助。在没有太多的乱七八糟之后，我决定：

    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

这似乎做得很好。我现在要做的就是弄清楚如何在此处向您表示感谢或其他内容:)