从 Excel 监视更改和电子邮件 [已关闭]

问：

我们有一个“信息”表，必须在我们拥有的每个工作文件（工作簿）上填写。我们想监测在F栏的某些方面所做的更改。如果在 F6：F10 中进行了更改，那么在用户尝试关闭文档之前，我们希望通过 Outlook 显示一封电子邮件。

收件人将位于单元格中，我们将说 F1。 主题将是不带文件扩展名的文档名称。

电子邮件的正文将包含来自已编辑的同一组的 A、B、C 和 F 列的信息。因此，在上面的示例中，它将是第 6：10 行。

如果编辑了另一组行，假设 F15：F18，那么将发送一封仅包含第 15：18 行的相同样式的电子邮件。此外，该组可能在单元格 F2 中具有不同的收件人。

也可能有第三种类型的组，这次如果编辑了 F21：F25，那么它将转到 F1 中的两个收件人;F2 键。

也可以在文件的相同使用中编辑所有 3 个组。

我们是否还可以出现一个消息框，上面写着“（#）电子邮件已成功发送”或“未发送电子邮件”。

非常感谢你能帮我做这件事的人。ChatGPT有其局限性，哈哈。

我可以准备好一封基本的电子邮件，并且可以根据此工作簿中的信息进行处理，但我无法弄清楚组的触发器以及初始值的记忆。

Function IsColumnDifferent( _
    ByVal OldData As Variant, _
    ByVal NewData As Variant, _
    Optional ByVal ColumnIndex As Long = 1) _
As Boolean
    Dim r As Long
    For r = LBound(OldData, 1) To UBound(OldData, 1)
        If CStr(OldData(r, ColumnIndex)) <> CStr(NewData(r, ColumnIndex)) Then
            IsColumnDifferent = True
            Exit For
        End If
    Next r
End Function

Sub SendMailSimple( _
         ByVal Subject As String, _
         ByVal Recipient As String, _
         ByVal Body As String)
    With CreateObject("Outlook.Application").CreateItem(0)
        .Subject = Subject
        .To = Recipient
        .Body = Body
        .Send
    End With
End Sub

Option Explicit

Private WorksheetNames As Variant
Private ValueRanges As Variant
Private OldValues As Variant

Private Sub Workbook_Open()
    WorksheetNames = VBA.Array("Info", "Info")
    ValueRanges = VBA.Array("E16:E20", "E22:E25", "E51", "E52", "E53", "E54", "E67:E68", "E71", "E84:E87", "E88:E91", "E92:E95", "E96:E99", "E100:E103", "E104:E107", "E110:E112", "E113:E115", "E116", "E117:E119", "E120:E122", "E123", "E124", "E126", "E127", "E128")
    OldValues = GetValues
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ComposeAndSendMails
End Sub

Private Sub ComposeAndSendMails()
    
    Const COPY_COLUMNS As String = "A:E"
    Const ROW_DELIMITER As String = vbLf
    Const COL_DELIMITER As String = " - "
    Dim cIndices(): cIndices = VBA.Array(1, 2, 3, 5) ' skip column 'D'
    Dim Recipients(): Recipients = VBA.Array("E61", "E65", "E61,E63", "E61,E63", "E61,E63", "E61,E63", "E61,E63", "E61,E63", "E61,E65", "E61,E65", "E61,E65", "E61,E65", "E61,E65", "E61,E65", "E61,E65", "E61,E65", "E61,E65", "E61,E65", "E61,E65", "K7,E61", "K7,E61", "K7,E61", "K7,E61", "K7,E61,E63")
    
    Dim rLen As Long: rLen = Len(ROW_DELIMITER)
    Dim cLen As Long: cLen = Len(COL_DELIMITER)
    Dim cUpper As Long: cUpper = UBound(cIndices)
    
    Dim BaseName As String:
    With ThisWorkbook
        BaseName = Left(.Name, InStrRev(.Name, ".") - 1)
    End With
    
    Dim NewValues(): NewValues = GetValues
    If IsEmpty(GetValues) Then Exit Sub ' covered in 'GetValues'
    
    Dim bData(), n As Long, r As Long, c As Long, eCount As Long
    Dim Body As String, Recipient As String
    
    For n = 0 To UBound(NewValues)
        If IsColumnDifferent(OldValues(n), NewValues(n)) Then
            With ThisWorkbook.Sheets(WorksheetNames(n))
                bData = .Range(ValueRanges(n)).EntireRow _
                    .Columns(COPY_COLUMNS).Value
                'Recipient = CStr(.Range(Recipients(n)).Value)
                    Dim cel As Range
                    Recipient = ""
                    For Each cel In .Range(Recipients(n))
                        Recipient = Recipient & ";" & CStr(cel)
                     Next
                        Recipient = Mid(Recipient, 2)
            End With
            For r = 1 To UBound(bData, 1)
                For c = 0 To cUpper
                    Body = Body & bData(r, cIndices(c)) & COL_DELIMITER
                Next c
                Body = Left(Body, Len(Body) - cLen)
                Body = Body & ROW_DELIMITER
            Next r
            Body = Left(Body, Len(Body) - rLen)
            SendMailSimple BaseName, Recipient, Body
            eCount = eCount + 1
            Body = ""
        End If
    Next n

    If eCount > 0 Then
        OldValues = NewValues
    End If
    
    MsgBox IIf(eCount = 0, "No", eCount) & " message" _
        & IIf(eCount = 1, "", "s") & " sent.", _
            IIf(eCount = 0, vbExclamation, vbInformation)

End Sub

Private Function GetValues() As Variant
    
    If IsEmpty(WorksheetNames) Then
        MsgBox "The initial information got lost!", vbExclamation
        Exit Function
    End If
 
    Dim UB As Long: UB = UBound(WorksheetNames)
    Dim Jag(): ReDim Jag(0 To UB)
    
    Dim n As Long
 
    For n = 0 To UB
        With ThisWorkbook.Sheets(WorksheetNames(n)).Range(ValueRanges(n))
            Jag(n) = .Value
        End With
    Next n
        
    GetValues = Jag
 
End Function