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 与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…