临近到期日时使用 Excel VBA 发送电子邮件通知

Question

我正在开发一个机器维护系统。当特定机器的维修日期临近时，我需要向进行机器维护的一方发送提醒电子邮件。

我想从服务详细信息表中搜索下一次服务的日期，并且我想从机器详细信息表中获取该特定机器的服务提供商的电子邮件地址。

我想发送两封电子邮件：

1. 服务日期前七天
2. 服务日期

电子邮件的正文应该是，

1. 计划于 2020 年 1 月 1 日为复印机（机器类型取自机器详细信息表）提供服务（下一个服务日期取自服务详细信息表。
2. 今天为复印机（机器类型取自机器详细信息表）安排了一项服务。

我想在不打开 Excel 文件的情况下自动发送电子邮件。

我浏览了许多类似的在线主题，但找不到我要搜索的内容，而且我对 VBA 的熟练程度不足以适应它们。

这是我正在使用的代码：

Sub email()

Dim r As Range
Dim cell As Range

Set r = Range("U2:U10000")

For Each cell In r
    If cell.Value = Date + 7 Then

        Dim Email_Subject, Email_Send_From, Email_Send_To, _
        Email_Cc, Email_Body As String
        Dim Mail_Object, Mail_Single As Variant
        Dim Machine_Code As Long
        Dim Machine_Type As Long

        Machine_Code = Application.WorksheetFunction.VLookup(cell.Value, Range("A:U"), 21, False)
        Machine_Type = Application.WorksheetFunction.VLookup(Machine_Code, Sheet1.Range("B:C"), 1, False)

        Email_Subject = "Service Reminder"
        Email_Send_From = "k.s@*******"
        Email_Send_To = Application.WorksheetFunction.VLookup(Machine_Code, Sheet1.Range("C:M"), 11, False)
        Email_Cc = "D@******.com"
        Email_Body = "There is a Service scheduled for a" & Machine_Type & "on" & cell.Value

        On Error GoTo debugs
        Set Mail_Object = CreateObject("Outlook.Application")
        Set Mail_Single = Mail_Object.CreateItem(0)
        With Mail_Single
            .Subject = Email_Subject
            .To = Email_Send_To
            .cc = Email_Cc
            .Body = Email_Body
            .send
        End With

    End If
Next

Exit Sub

debugs:
    If Err.Description <> "" Then MsgBox Err.Description
End Sub

Answer 1

调度宏并不像听起来那么困难！ 下面的代码可以在任何给定时间执行它所在的模块内的任何子 task_sub 在您的情况下是“电子邮件”！

Sub schedule_macro()
Application.OnTime "05:00:00", "task_sub"
End Sub

这是要让这个宏工作的关键。包含您的宏的文件需要打开，基本上总是真正有意义。

为了避免这种情况，windows（我猜所有其他操作系统都有类似的选项）有任务计划程序。我找到了一个很好的解释here。

现在，这仍然需要在白天的某个时间点开启您的机器。因此，也许您可​​以简单地将所有这些安排在午休时间，以免打断您的正常日程安排。如果去度假，只需将例程复制粘贴给您休假期间将在办公室的同事。

希望这些信息对你有所帮助！