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

然后你可以使用嵌套循环

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

使用类似这样的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

这似乎很好地解决了这个问题。我现在要做的就是弄清楚如何在这里给你一个感谢或者什么：）

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

2 个答案: