Excel VBA自动发邮重复问题：重启表格后如何更新previousValue

问题根源 #

你的代码存在两个核心问题：

1. previousValue仅在内存中临时存储，关闭Excel文件后就会丢失。重新打开文件保存时，代码会重新初始化该值，导致误判变更。
2. 循环中未给currentValue赋值，逻辑判断currentValue <> previousValue实际无效，这会导致每次保存都触发邮件发送。

解决方案 #

通过持久化存储历史值解决重复发送问题：

• 在工作表中新增一个隐藏列（比如列Z），用于记录每行F列的上次发送值。
• 每次保存时，对比当前F列值和对应隐藏列的值，只有当两者不同时才发送邮件，发送后更新隐藏列的值。

修改后的完整代码 #

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentValue As Variant
    Dim lastSentValue As Variant
    Dim olApp As Object
    Dim olMail As Object
    Dim i As Integer ' 补充声明循环变量
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 根据实际表名修改
    
    ' 获取F列最后一行数据行号
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
    
    ' 初始化隐藏列（Z列），如果是首次使用，将当前F列值写入Z列
    If ws.Cells(1, "Z").Value <> "Last Sent F Value" Then
        ws.Cells(1, "Z").Value = "Last Sent F Value"
        ws.Columns("Z").Hidden = True ' 隐藏Z列
        For i = 2 To lastRow
            ws.Cells(i, "Z").Value = ws.Cells(i, "F").Value
        Next i
    End If
    
    ' 遍历行检测变更
    For i = 2 To lastRow
        currentValue = ws.Cells(i, "F").Value
        lastSentValue = ws.Cells(i, "Z").Value
        
        ' 仅当值发生变化时发送邮件
        If currentValue <> lastSentValue Then
            ' 创建Outlook邮件对象
            Set olApp = CreateObject("Outlook.Application")
            Set olMail = olApp.CreateItem(0)
            
            ' 配置邮件信息
            olMail.To = ws.Cells(i, "B").Value
            olMail.Subject = "Change Detected: " & ws.Cells(i, "A").Value
            olMail.Body = "Dear Recipient," & vbCrLf & _
                          " " & vbCrLf & _
                          "A change has been detected for " & ws.Cells(i, "A").Value & vbCrLf & _
                          " " & vbCrLf & _
                          "Details: " & ws.Cells(i, "C").Value & vbCrLf & _
                          " " & vbCrLf & _
                          "Your incident has been escalated to the EBMS Technical Team for additional triage and investigation. Should they require additional information to diagnose the incident, they may reach out to you using the information you provided to the EBMS Support Team." & vbCrLf & _
                          " " & vbCrLf & _
                          "Best regards," & vbCrLf & _
                          "Site Support"
            
            ' 发送邮件
            olMail.Send
            
            ' 更新隐藏列的历史值
            ws.Cells(i, "Z").Value = currentValue
            
            ' 释放当前邮件对象
            Set olMail = Nothing
        End If
    Next i
    
    ' 释放Outlook应用对象
    Set olApp = Nothing
End Sub

关键说明 #

• 隐藏列Z会自动创建并初始化，首次运行后会隐藏，避免误编辑。
• 每次发送邮件后，会立即更新Z列的对应值，确保下次保存时不会重复触发。
• 补充了循环变量i的声明，符合VBA规范。

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