问题描述
我正在尝试调用几个模块,这些模块被设置为使用函数向表中列出的指定用户发送电子邮件。电子邮件遵循的逻辑应该设置为在 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
结束子
解决方法
无论最后一封电子邮件的日期如何,都应该能够通过一个程序完成此操作。
仅提取符合 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()