如何使我的Excel表格自动更新以触发基于VBA中单元格值的电子邮件发送？

Question

当单元格值变为45时，如何使Excel工作表自动生成电子邮件？

为此，我创建了2个Excel工作簿。第一个(Workbook-1)包含一个列，它计算特定事件的实际天数(事件日期-今天())。第二个(Workbook-2)具有相同的列，但它只是从(Workbook-1)中获取这些值。

工作簿-2的目的是收集电子邮件中使用的最重要的数据。例如，如果今天剩下的天数是46天，那么明天它将在两个工作簿中自动更新，并将变成45天。在这里，我希望第二个工作簿触发电子邮件发送，而不需要我的进一步干预。

我准备了下面的代码(针对Workbook-2)，它实际上与我一起工作，但仅在2种情况下: 1)当我在相应的单元格中手动复制和粘贴公式时，值已经是45；2)当我选择相应的单元格并在公式栏中按Enter。

这些选项都不适合我，因为我的想法是自动化这个过程。

这里是代码：

Dim xRg As Range

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Intersect(Range("H2:H75"), Target)

    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value = 45 Then
        Call Mail_small_Text_Outlook(Target)
    End If
End Sub

Sub Mail_small_Text_Outlook(val)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Dim xMailSubject As String
    Dim xMailTo As String
    Dim xMailCc As String

    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)

    xMailBody = "<b>Dear </b>" & "<b>" & val.Offset(0, -1).Value & "</b>" & "<b>!</b>" & "<br /><br />" & _
        "Hereby please be kindly informed, that the following offer will expire on " & "<span style='font-weight:bold'>" & val.Offset(0, -2).Value & "</span>" & "," & " that is, after " & val.Offset(0, 0).Value & " days from the date of this email." 

    xMailSubject = val.Offset(0, 1).Value
    xMailTo = val.Offset(0, 2).Value
    xMailCc = val.Offset(0, 3).Value

    On Error Resume Next
    With xOutMail
        .To = xMailTo
        .CC = xMailCc
        .BCC = ""
        .Subject = xMailSubject
        .HTMLBody = xMailBody
        .Display   
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

同时，我已经阅读了很多关于这个问题的文章，其中大多数建议使用Application.Volatile方法强制Excel重新计算目标单元格值(在我的例子中只有一列)，还有一些建议强制excel每秒自动更新。从根本上说，它们中的大多数都不全面。那么，哪一种最适合我的特殊情况？

Answer 1

我认为，您的问题来自这样一个事实，即没有任何东西触发Application.Calculation。如果打开工作簿，并且没有任何要求Today()进行计算，则Excel公式不会返回新日期。因此，我建议您使用Workbook_Open()事件，以便在特定时间调用一个函数，该函数将更改日期，使Excel计算(如果是Application.Calculation = xlCalculationAutomatic)。然后，讨论中的函数将递归地工作，设置下一次操作：

Private Sub Workbook_Open()
    Application.Calculation = xlCalculationAutomatic
    Application.OnTime TimeSerial(0, 0, 0), "Date_Change"
End Sub

Sub Date_Change()
    Dim sh As Worksheet
    Set sh = ActiveSheet ' use here your sheet
    sh.Range("A2").Value = Date
    '"programming" the function to act nex time/day
    Application.OnTime TimeSerial(0, 0, 0), "Date_Change"
End Sub

"A2“范围值(或您将选择的任何范围)必须是计算该值的基础，该值能够触发发送邮件函数。