Excel VBA单元格组编辑触发邮件脚本仅前两组生效，后续组无响应的问题求助

大家好，我最近在写Excel VBA脚本时遇到了一个棘手的问题，想请各位帮忙排查一下。

我有一个名为"Info"的工作表，在处理工作任务时会在这个表上记录特定信息，希望每当这些信息填写完成后，能自动给指定联系人发送邮件。这些需要关注的信息是按组划分的——发送整个工作表或者只发修改的单个单元格都不合理，应该发送被编辑单元格所在的整个组的内容。

目前脚本对前两组单元格（E16:E20和E22:E25）能正常触发邮件，但编辑后面其他组的单元格时，完全不会发送邮件，这让我摸不着头脑。

我尝试过修改工作表上的收件人设置，想让一个组对应多个收件人时，代码不用处理多个单元格，但还是没解决问题。

以下是我的完整代码：

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

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

希望各位能帮我找出问题所在，谢谢大家！

备注：内容来源于stack exchange，提问作者Travis Gainey