求助：实现Excel关闭前检测指定区域变更并自动发送邮件

原代码核心问题是未在文件打开时初始化存储初始值，导致第一次关闭文件时无法正确对比打开时的原始数据与修改后的数据，同时存在代码冗余、效率偏低的问题。以下是修正后的完整代码及改动说明：

' 存储两个监控区域的初始值
Private originalValues1 As Variant
Private originalValues2 As Variant

' 工作簿打开时初始化存储初始值
Private Sub Workbook_Open()
    Dim rng1 As Range, rng2 As Range
    Set rng1 = ThisWorkbook.Worksheets("Info").Range("E16:E20")
    Set rng2 = ThisWorkbook.Worksheets("Info").Range("E22:E25")
    
    ' 将区域值存入数组（高效存储）
    originalValues1 = rng1.Value
    originalValues2 = rng2.Value
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim rng1 As Range, rng2 As Range
    Set rng1 = ThisWorkbook.Worksheets("Info").Range("E16:E20")
    Set rng2 = ThisWorkbook.Worksheets("Info").Range("E22:E25")
    
    ' 检测rng1变更并发送邮件
    If HasChanges(rng1, originalValues1) Then
        SendChangeEmail rng1, ThisWorkbook.Worksheets("Info").Range("E61").Value
    End If
    
    ' 检测rng2变更并发送邮件
    If HasChanges(rng2, originalValues2) Then
        SendChangeEmail rng2, ThisWorkbook.Worksheets("Info").Range("E63").Value
    End If
End Sub

' 通用检测变更函数（直接对比数组，效率更高）
Private Function HasChanges(rng As Range, originalValues As Variant) As Boolean
    Dim currentValues As Variant
    currentValues = rng.Value
    
    ' 防御性判断：如果原始值未初始化（理论上不会触发，因为Open事件已初始化）
    If IsEmpty(originalValues) Then
        HasChanges = False
        Exit Function
    End If
    
    ' 遍历数组对比值
    Dim i As Long, j As Long
    For i = LBound(currentValues, 1) To UBound(currentValues, 1)
        For j = LBound(currentValues, 2) To UBound(currentValues, 2)
            If currentValues(i, j) <> originalValues(i, j) Then
                HasChanges = True
                Exit Function
            End If
        Next j
    Next i
    
    HasChanges = False
End Function

' 通用发送邮件函数（避免代码重复）
Private Sub SendChangeEmail(targetRng As Range, recipient As String)
    Dim fileName As String
    Dim body As String
    Dim cell As Range
    
    ' 获取不含扩展名的文件名
    fileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
    
    ' 构建邮件正文
    body = ""
    For Each cell In targetRng
        body = body & cell.Offset(0, -4).Value & " - " & _
               cell.Offset(0, -3).Value & " - " & _
               cell.Offset(0, -2).Value & " - " & _
               cell.Value & vbCrLf
    Next cell
    
    ' 发送邮件
    Dim outApp As Object, outMail As Object
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItem(0)
    
    With outMail
        .Subject = fileName
        .To = recipient
        .Body = body
        .Send ' 如需预览邮件可改为.Display
    End With
    
    ' 释放对象
    Set outMail = Nothing
    Set outApp = Nothing
End Sub

关键改动说明 #

• 新增Workbook_Open事件：在文件打开时立即存储两个监控区域的初始值，确保关闭时对比的是「打开时的原始数据」和「关闭前的当前数据」。
• 重构通用函数：将邮件发送逻辑封装为SendChangeEmail，避免重复代码；变更检测改为直接对比数组，比遍历单元格效率更高。
• 移除冗余代码：删除未实际使用的emailScheduled系列变量，移除BeforeClose事件末尾无意义的初始值重置操作。
• 优化逻辑严谨性：在HasChanges函数中增加防御性判断，避免异常情况触发错误。

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