ms-access - 根据查询结果发送通知邮件

Question

我有一个显示“FirstName”、“LastName”、“DueDate”的查询表。我想做的是创建一个后续流程。如果截止日期是今天 (date())，访问需要向一个通用电子邮件地址发送通知电子邮件。

我的代码仅适用于查询中的第一条记录，它不适用于其他记录。

这是我使用的代码；

Public Sub FollowUpEmail()

Dim db As DAO.Database
Dim rs As DAO.Recordset

Dim oApp As Object
Dim oEmail As Object

Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(0)


Set db = CurrentDb
                strSQL = "SELECT FirstName, SurName, DueDate" & _
                            " FROM TestQuery"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)


While Not rs.EOF
SendKeys "^{ENTER}"
With oEmail
.To = "xxx"
.Subject = rs.Fields("FirstName").Value & "/" & "Deadline"
.Body = "test"
.Display

End With
rs.MoveNext
Wend


rs.Close

Set rs = Nothing
Set db = Nothing


Set oApp = Nothing
Set oEmail = Nothing


End Sub

标签： ms-accessvba

Answer 1

您需要为循环的每次迭代创建并发送一封新电子邮件，例如：

Public Sub FollowUpEmail()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset

    Dim oApp As Object
    Set oApp = CreateObject("Outlook.Application")

    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT FirstName, SurName, DueDate FROM TestQuery")

    Do Until rs.EOF
        With oApp.CreateItem(0)
            .To = "xxx"
            .Subject = rs!FirstName & "/" & "Deadline"
            .Body = "test"
            .Display
        End With
        rs.MoveNext
    Loop
    rs.Close

    Set rs = Nothing
    Set db = Nothing
    Set oApp = Nothing
End Sub

或者，如果您想直接发送电子邮件：

Public Sub FollowUpEmail()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset

    Dim oApp As Object
    Set oApp = CreateObject("Outlook.Application")

    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT FirstName, SurName, DueDate FROM TestQuery")

    Do Until rs.EOF
        With oApp.CreateItem(0)
            .To = "xxx"
            .Subject = rs!FirstName & "/" & "Deadline"
            .Body = "test"
            .Send
        End With
        rs.MoveNext
    Loop
    rs.Close

    Set rs = Nothing
    Set db = Nothing
    Set oApp = Nothing
End Sub