正在尝试使用VBA Code for Access搜索表中的所有行

Question

我正在尝试调用几个模块，这些模块被设置为使用函数向表中列出的指定用户发送电子邮件。电子邮件遵循的逻辑应该设置为在7天后向每个用户发送电子邮件，这取决于他们之前收到电子邮件的前一个日期(FirstEmailDate、SecondEmailDate、ThirdEmailDate和FinalEmailDate)。我很难理解这种逻辑，搜索整个表的每一行，并且能够自动在每个电子邮件日期的字段中添加日期和时间戳。如有任何关于此编码的帮助，我们将不胜感激。谢谢

下面只是一个模块的例子：

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

结束子

Answer 1

不管最后一封电子邮件的日期如何，真的应该能够用一个过程来完成这项工作。

仅提取符合7天标准的记录。计算一个字段，该字段标识要更新的周期和字段。假定在创建记录时填充FirstEmailDate。

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")

使用记录集中的Fld值更新相应的字段
rs(rs!Fld & "EmailDate") = Date()