Access 2016 vba to send email based on query results and record date email sent back to same table

0
votes

I am using vba code to have Access 2016 send emails via Outlook 2016 based on query results. The code works perfectly in its current state. Basically, this is designed to automate a follow up process 19 days after an estimate is provided to a client.

However, in the same table that the query pulls from exists an open field for each record titled [FUP_Sent_Date]. I would like this process to go back to that field for each client it sends an email to and insert the current date in that client's record as evidence that the email was sent (also because that field will become a 2nd and integral part of the query criteria in that I only want to send emails to those that have not already been sent one).

Can you help? Many thanks in advance.

Code follows and bear in mind that the text in the body is just jibberish at this time:

Public Sub SendFollowUpEmail()

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

Dim emailTo As String
Dim emailSubject As String
Dim emailText As String

Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outlookStarted As Boolean


On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
    Set outApp = CreateObject("Outlook.Application")
    outlookStarted = True
End If

Set db = CurrentDb
                strSQL = "SELECT Estimate_Date, First_Name, Last_Name, Client_Email, FUP_Date_Sent " & _
                            " FROM qry_PropFolUp WHERE Estimate_Date = (Date()-19)"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
Do Until rs.EOF

    emailTo = Trim(rs.Fields("First_Name").Value & " " & rs.Fields("Last_Name").Value) & _
                " <" & rs.Fields("Client_Email").Value & ">"

    emailSubject = "Proposal Follow Up"
    If IsNull(rs.Fields("First_Name").Value) Then
        emailSubject = emailSubject & " for " & _
                        rs.Fields("First_Name").Value & " " & rs.Fields("Last_Name").Value
    End If

    emailText = Trim("Hi " & rs.Fields("First_Name").Value) & "!" & vbCrLf


    emailText = emailText & _
                "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. " & rs.Fields("Estimate_Date").Value & _
                " Maecenas porttitor congue massa. Fusce posuere, magna sed " & _
                "pulvinar ultricies, purus lectus malesuada libero, sit amet " & _
                "commodo magna eros quis urna."

    Set outMail = outApp.CreateItem(olMailItem)
    outMail.To = emailTo
    outMail.Subject = emailSubject
    outMail.Body = emailText
    outMail.Send

                    rs.Edit
                    rs("FUP_Date_Sent") = Now()


    rs.MoveNext
Loop

rs.Close
Set rs = Nothing
Set db = Nothing

If outlookStarted Then
    outApp.Quit
End If

Set outMail = Nothing
Set outApp = Nothing

End Sub

1
ms-access
open your recordset as a dynaset (you've indicated nothing, and I believe default is snapshot). Before your rs.movenext, give the recordset an edit...update with the timestamp. (You'd need to select the field you want to update obviously) – geeFlo
Thanks so much for the quick response. Although I appreciate your confidence in my vba programming abilities, I'm unfortunately not clear on the actual coding for that. I have tried the following without success: – Steve K
See updated code in original post to see my additions that have failed to rsult in any new info in the [FUP_Email_Sent] field. – Steve K
check out the answer below. Also, you know you can change 'rs.Fields("First_Name").Value' to simply 'rs!First_Name' A lot cleaner. – geeFlo

1 Answers

0
votes

You almost had it all. 

rs.Edit
rs("FUP_Date_Sent") = Now()
rs.update