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

时间:2019-02-19 12:34:10

标签: vba ms-access access-vba

我有一个查询表,其中显示“ 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

1 个答案:

答案 0 :(得分:0)

您将需要为循环的每次迭代创建并发送新电子邮件,例如:

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
相关问题