Attempting to search all rows in a table using VBA Code for Access

Question

I'm trying to call several modules that are set up to send an email to specified users who are listed in a table using a function. The logic that the emails follow are supposed to be setup to email each user after 7 days contingent upon the preceding date that they were emailed previously (FirstEmailDate, SecondEmailDate, ThirdEmailDate, and FinalEmailDate). I'm having a hard time with that logic, searching each row of the entire table, and being able to automatically add a date and timestamp to the fields for each email date. Any help with this coding would greatly appreciated. Thank you

Below is just one module as an example:

Option Compare Database
Option Explicit

Sub EmailFinalAttempt()
   
Dim db As DAO.Database
Dim rs As DAO.Recordset

Dim emailTo As String
Dim emailSubject As String
Dim emailText As String
Dim UPDATE As String
Dim Edit As String
Dim strCompleted As String
Dim strMessage As String

Dim oApp As New Outlook.Application
Dim oMail As Outlook.MailItem
Dim oStarted As Boolean
Dim EditMessage As Object

Dim qdf As QueryDef
    
On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If oApp Is Nothing Then
    Set oApp = CreateObject("Outlook.Application")
    oStarted = True
End If

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT * FROM ProductRequestForm")
        
rs.MoveFirst
Do While Not rs.EOF
    
    emailTo = 'email address'
    
    emailSubject = "Final Email Attempt"
    
    emailText = Trim("Hello " & rs.Fields("SubmitterFirstName").Value) & "," & vbCrLf
    
    If (rs.Fields("ThirdEmailDate").Value >= 7 Or (IsNull(rs.Fields("FinalEmailDate").Value))) And (rs.Fields("ThirdEmailDate").Value) Then
        emailText = emailText & "message body" & _ vbCrLf
    
    ' If today is greater than third attempt date and third attempt is + Null then send email
        
    End If
        rs.MoveNext
    Loop
    
        rs.MoveFirst
        Do While Not rs.EOF
        If rs.Fields("Completed?").Value = "Active" Then
        rs.Edit
        rs.Fields("Completed?").Value = "Inactive"
        rs.UPDATE
    
    End If
    
       rs.MoveNext
     Loop
        
        rs.MoveNext
        Do While Not rs.EOF
        If rs.Fields("FinalEmailDate").Value Then
        rs.Edit
        rs.Fields("FinalEmailDate").Value = Date
        rs.UPDATE
        
    End If
        
        rs.MoveLast
        
    Set oMail = oApp.CreateItem(0)
    
    With oMail
        .To = emailTo
        .Subject = emailSubject
        .Body = emailText
        '.Save
        DoCmd.SendObject acSendForm, "ProductRequestForm", acFormatXLS, emailTo, , , emailSubject, emailText, False
        DoCmd.SetWarnings (False)
        
     End With
      
    rs.MoveNext
Loop

    rs.Close

Set rs = Nothing
Set db = Nothing

If oStarted Then
    oApp.Quit
End If

Set oMail = Nothing
Set oApp = Nothing

End Sub

question from:https://stackoverflow.com/questions/65851576/attempting-to-search-all-rows-in-a-table-using-vba-code-for-access

Answer 1

Really should be able to do this with one procedure regardless of last email date.

Only pull records that meet 7-day criteria. Calculate a field that identifies which cycle and field to update. Presume FirstEmailDate is populated when record created.

Set rs = db.OpenRecordset("SELECT *, " & _
           " Switch(IsNull(SecondEmailDate),"Second", IsNull(ThirdEmailDate),"Third", True,"Final") AS Fld " & _
           " FROM ProductRequestForm WHERE FinalEmailDate Is Null " & _
           " AND Nz(ThirdEmailDate, Nz(SecondEmailDate, FirstEmailDate)) <= Date()-7")

Use Fld value from recordset to update appropriate field.
rs(rs!Fld & "EmailDate") = Date()