Отправка уведомлений по электронной почте на основе результатов запроса - PullRequest
Новая
       7

Отправка уведомлений по электронной почте на основе результатов запроса

0 голосов
/ 19 февраля 2019

У меня есть таблица запросов, которая показывает «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 голосов
/ 19 февраля 2019

Вам нужно будет создать и отправить новое электронное письмо для каждой итерации цикла, например: 

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
...