我想在 access 中设置每两周一次的电子邮件提醒

Posted 2023-05-07

【中文标题】我想在 access 中设置每两周一次的电子邮件提醒

【英文标题】：I want to set up my email reminder on a bi-weekly basis in access

【发布时间】：2016-08-03 13:19:12

【问题描述】：

我需要帮助创建一些将每两周发送一次电子邮件提醒的代码。我已经有发送电子邮件提醒的代码，但它每天发送一次电子邮件。这对用户来说可能非常烦人

这是我访问的 vba 代码：

 Function GenerateEmail(mysql As String)
 'On Error GoTo Exit_Function:
  Dim oOutLook As Outlook.Application
  Dim oEmailAddress As MailItem
  Dim MyEmpName As String
  Dim MyEquip As String
  Dim MyModel As String
  Dim MyAsset As String
  Dim MySerial As String
  Dim rs As Recordset
  Set rs = CurrentDb.OpenRecordset(MySQL)
 If rs.RecordCount > 0 Then
rs.MoveFirst
Do Until rs.EOF
If IsNull(rs!EmailAddress) Then
        rs.MoveNext
Else
If oOutLook Is Nothing Then
Set oOutLook = New Outlook.Application
End If
 Set oEmailAddressItem = oOutLook.CreateItem(olMailItem)
 With oEmailAddressItem

           MyEmpName = DLookup("EmpName", "Employees", "[EmpID]= " & rs!EmpName)
            MyEquip = rs!EquipmentType
            MyModel = rs!ModelNo
            MyAsset = rs!AssetNo
            MySerial = rs!SerialNo
            .To = "another@.com;another@.com;another@.com"
            .Subject = "Calibration that's due between 1 to 11 months"
            .Body = "Calibration ID: " & rs!RecordID & vbCr & _
                    "Location: " & rs!CalLocation & vbCr & _
                   "Requirement: " & rs!CalRequirement & vbCr & _
                   "Employee: " & MyEmpName & vbCr & _
                   "Name: " & MyEquip & vbCr & _
                   "Serial No.: " & MySerial & vbCr & _
                   "Model No.: " & MyModel & vbCr & _
                   "Asset No.: " & MyAsset & vbCr & _
                   "Due Date : " & rs!CalUpcomingDate & vbCr & vbCr & _
                   "This email is auto generated. Please Do Not Replay!"
            'MyEmpName = DLookup("EmpName", "Employees", "[EmpID]= " & rs!EmpName)
            '.To = rs!EmailAddress
            '.Subject = "Task due in between 1st and 11th month reminder for " & MyEmpName
            '.Body = "Task ID: " & rs!RecordID & vbCr & _
                   '"Task Name: " & rs!TaskName & vbCr & _
                   '"Employees: " & MyEmpName & vbCr & _
                  ' "Task Due: " & rs!CalUpcomingDate & vbCr & vbCr & _
                   '"This email is auto generated from Task Database. Please Do Not Replay!"
             .Display
             '.Send
             ' rs.Edit
             ' rs!DateEmailSent = Date
             ' rs.Update
      End With
      Set oEmailAddressItem = Nothing
      Set oOutLook = Nothing
      rs.MoveNext
  End If
Loop
Else
'do nothing
End If
rs.Close
Exit_Function:
Exit Function
End Function

【问题讨论】：

向表中添加一个具有 Sent 日期的字段，然后过滤 Sent 日期为 Null 或超过两周的日期。对于此记录集更新发送到Date()。

这行得通。我问的原因是因为我有一个尚未开始的校准列表即将到期。我想每两周提醒用户一次。通知他们每次校准及其截止日期，以便他们始终保持警惕。

calibarationDate 是否在其他表中，或者它们是同一条记录中的字段？

如果您指的是 SerialNo、ModelNo、AssetNo 和 Equip 而不是 no。这些字段在设备表中。到期日期员工、位置和 ID 在校准表中。我为这些记录创建了一个查询，以创建一个状态为“未开始”的校准列表。我正在尝试每两周将该列表作为电子邮件提醒发送给用户。我需要知道我的 GenerateEmail 中是否需要某种类型的 vba 代码，它会让系统知道每两周只发送一次此列表。

@Gustav 当您提到更新发送到日期（）时，您指的是什么代码。你指的是 rs!DateEmailSent = Date 还是查询？

【参考方案1】：

看来您曾经有过正确的想法——@Gustav 指出了解决方案。

您首先需要取消注释这些行：

' rs.Edit
' rs!DateEmailSent = Date
' rs.Update

然后更改处理每个电子邮件地址时发生的情况：

建议的程序新外观：

rs.MoveFirst
Do Until rs.EOF

    If Not IsNull(rs!EmailAddress) Then

        ' Only Send Emails if never been sent before - or past 14 days since last one'
         If (IsNull(rs!DateEmailSent)) Or DateDiff("d", rs!DateEmailSent, Date) >= 14 Then

            If oOutLook Is Nothing Then
                Set oOutLook = New Outlook.Application
            End If
            Set oEmailAddressItem = oOutLook.CreateItem(olMailItem)

            ' ... rest of email processing '
            ' .................... '

            .Display
            .Send

            ' Make sure to record that reminder was sent '
             rs.Edit
             rs!DateEmailSent = Date
             rs.Update

            ' Only do this if this has been set '
            Set oEmailAddressItem = Nothing
         End If
    End If

    rs.MoveNext
Loop

' Do this at end '
Set oOutLook = Nothing

【讨论】：

这几乎涵盖了它。

谢谢@dbmitch

@dbmitch。现在一切正常。我有另一个问题。我想包括接近 LeadDate 的 2 周。我该怎么做呢。

我应该知道什么是 LeadDate 以及您希望如何包含它吗？作为一个新领域？作为一个新的标准？结合其他标准？如果它是微不足道的，您可能应该开始一个新问题或更新以上问题。

@dbmitch。提前期是生产过程的开始和完成之间的时间。我称它为 Lead Date，因为我创建了一些代码来计算对日期的更改。 Lead Date 是我在查询中创建的字段。如果校准在 2016 年 9 月 15 日到期，我将从该到期日中减去交货时间。交货时间最多可以测量为 3 周、6 周、9 周、12 周等。一旦你有了这个计算，我想在接近 LeadDate 的 2 周内发送一个校准提醒。这对你有意义吗？