基于公式的单元格值触发的 VBA 电子邮件代码

Posted 2023-03-27

【中文标题】基于公式的单元格值触发的 VBA 电子邮件代码

【英文标题】：VBA email code triggered by Cell Value based off of a Formula

【发布时间】：2022-01-15 07:18:07

【问题描述】：

我对 Excel 中的 VBA 非常陌生，只是复制了我在互联网上找到的这段代码。问题是，目前只有在将 Q 列中的值手动更改为 30 时才会发送电子邮件，但是，我有一个公式用于此单元格编号自动更新（它是运行天数），所以我希望它根据公式触发 VBA，无需手动将值输入单元格。 任何帮助都会很棒！

    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("Q2:Q6000"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value = 30 Then
        Call Mail_small_Text_Outlook(Range("A" & Target.Row).Value)
    End If
End Sub

Sub Mail_small_Text_Outlook(mailSubject As String)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "mail body"
    On Error Resume Next
    With xOutMail
        .To = "email"
        .CC = ""
        .BCC = ""
        .Subject = mailSubject
        .Body = xMailBody
        .Send   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
Private Sub Worksheet_Calculate()
Dim xI As Integer
Dim xRg As Range
Set xRg = Range("Q2:Q6000")
On Error GoTo Err01
xI = Int(xRg.Value)
If xI = 30 Then
Call Mail_small_Text_Outlook(Range("A" & Target.Row).Value)
End If
Err01:
End Sub

【问题讨论】：

这种方法可能会针对相同的值多次发送电子邮件 - 每次您的工作簿计算时。这可能不是你想要的。另外，在您的 Calculate 事件处理程序中，您没有 Target 来限制要扫描的范围，因此 Q2:Q6000 中的多个单元格可能 >30：那么应该发生什么？

每当 Q 列中的值 = 30 时，我都希望触发电子邮件。如果 > 30 或

如果工作表计算了五次并且在重新计算期间没有值改变怎么办？例如。假设每次计算结束时相同的 5 个单元格 = 30：您真的想要每个单元格一封邮件（所以 25 封邮件），还是一封列出所有单元格的邮件（5 封邮件）？

该公式是一个运行天数，因此当行中的每个单元格达到 30 时，我想要一封来自该单元格的电子邮件，但每天只运行一次。第二天将是 31，因此它不应触发该单元格的电子邮件。这应该只与 Q 列中的值相关。希望这是有道理的。

【参考方案1】：

试试这个：

Private Sub Worksheet_Calculate()
    Const CHECK_RANGE As String = "Q2:Q6000"
    Const INFO_COL As String = "A" 'info for the email
    Const FLAG_COL As String = "R" 'column to store "sent mail" date
    
    Dim c As Range, v, dt
    For Each c In Me.Range(CHECK_RANGE).Cells
        v = c.Value
        If IsNumeric(v) Then
            If v = 30 Then
                'already sent a mail today?
                If c.EntireRow.Columns(FLAG_COL).Value <> Date Then
                    c.EntireRow.Columns(FLAG_COL).Value = Date 'record send date
                    Debug.Print c.Address 'for testing
                    'Mail_small_Text_Outlook c.EntireRow.Columns(INFO_COL).Value
                End If
            End If
        End If
    Next c
End Sub

如果每个单元格每天只发送一封邮件。

【讨论】：

这确实可以触发电子邮件发送！但是我不得不用这段代码替换顶部，否则它会向我发送连续的电子邮件。非常感谢！

“替换顶部”是什么意思？如果您使用Calculate 事件触发警报，“连续邮件”是我在上面的 cmets 中警告的内容。

Nvm 那部分我想通了，但是如果我每个单元格值只能收到 1 封电子邮件，那将是最好的。我只使用了Calculate 函数，因为在另一个线程中提到它可以工作..

如果您在工作表中添加“已发送邮件”列，您可以在一行中添加发送邮件的日期 - 检查下一次运行时是否为今天的日期- 发送邮件。

在上面查看我的更新。