Excel VBA：解决Worksheet_Change触发Outlook邮件重复发送问题

核心思路 #

通过记录邮件发送状态避免重复触发：在工作表中预留一个单元格存储邮件是否已发送的标记，每次触发事件时先检查该标记，若已发送则跳过；当库存恢复到阈值以上时，重置标记以便下次触发。

步骤1：清理冗余的邮件发送代码 #

你的Mail_Radio_Waldrand子过程存在重复发送逻辑，先删除冗余部分，优化后代码如下：

Sub Mail_Radio_Waldrand()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Hallo Sari" & vbNewLine & vbNewLine & _
              "Der CD-Bestand von Radio Waldrand ist unter dem Mindestbestand von 10 Stück." & vbNewLine & _
              "Bitte bestellen."
    
    On Error Resume Next
    With OutMail
        .To = "opr6@dreischiibe.ch"
        .CC = ""
        .BCC = ""
        .Subject = "Marius & die Jagdkapelle: CD-Bestand von Radio Waldrand unterschritten"
        .Body = strbody
        .Send ' 仅保留一次发送逻辑
    End With
    On Error GoTo 0
           
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

步骤2：添加发送状态标记与判断逻辑 #

选择一个不影响日常操作的单元格（比如2023 Materialbestand工作表的Z1单元格），用来存储发送状态：True表示已发送，False表示未发送。修改事件与库存检查代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 禁用事件避免递归触发
    Application.EnableEvents = False
    Call Materialbestand
    Application.EnableEvents = True
End Sub

Sub Materialbestand()
    Dim ws As Worksheet
    Dim stockThreshold As Integer
    Dim sentFlag As Range
    
    Set ws = Worksheets("2023 Materialbestand")
    stockThreshold = 10 ' 匹配你描述的10件阈值，原代码中20为笔误可自行调整
    Set sentFlag = ws.Range("Z1")
    
    ' 初始化标记：单元格为空时默认设为未发送
    If sentFlag.Value = "" Then sentFlag.Value = False
    
    ' 核心判断逻辑
    If ws.Range("B9").Value < stockThreshold And sentFlag.Value = False Then
        Call Mail_Radio_Waldrand
        sentFlag.Value = True ' 标记为已发送
    ' 库存恢复阈值以上时重置标记
    ElseIf ws.Range("B9").Value >= stockThreshold And sentFlag.Value = True Then
        sentFlag.Value = False
    End If
End Sub

补充说明 #

1. 阈值调整：若实际阈值不是10，修改stockThreshold变量的值即可。
2. 隐藏标记单元格：右键点击Z1→设置单元格格式→保护→勾选“隐藏”，再保护工作表（可选），防止误修改标记。
3. 事件禁用：Application.EnableEvents = False用于避免修改标记单元格时再次触发Worksheet_Change事件，引发递归错误。

内容的提问来源于stack exchange，提问作者user16544846