请求优化VBA邮件发送代码：合并同账户交易至单封邮件

需求说明 #

原代码逐行读取Excel数据并发送单独邮件，现需优化为：

• 识别B列（账户编号）的相同值，将同一账户的多笔交易合并至单封邮件发送
• 邮件中生成对应多笔交易的合并摘要表格
• 自动添加该账户所有交易对应的附件

优化后完整代码 #

Sub SendEmail_Dispute()
    Dim EmailApp As Outlook.Application
    Dim EmailItem As Outlook.MailItem
    Dim fso As Scripting.FileSystemObject
    Dim folder As Scripting.folder
    Dim file As Scripting.file
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim accountNum As String
    Dim htmlBody As String
    Dim transactionRows As Range
    Dim cell As Range
    
    '初始化核心对象
    Set EmailApp = New Outlook.Application
    Set fso = New FileSystemObject
    Set folder = fso.GetFolder("C:\Users\main\Desktop\sus trx")
    lastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
    
    '用Z列临时标记已处理行，避免重复发送（可根据实际调整列位置）
    Sheet2.Columns("Z").Clear
    Sheet2.Range("Z1").Value = "已处理"
    
    For i = 2 To lastRow
        '跳过已处理的行
        If Sheet2.Range("Z" & i).Value <> "已处理" Then
            accountNum = Sheet2.Range("B" & i).Value
            '收集同一账户的所有交易行
            Set transactionRows = Sheet2.Range("B" & i)
            For j = i + 1 To lastRow
                If Sheet2.Range("B" & j).Value = accountNum And Sheet2.Range("Z" & j).Value <> "已处理" Then
                    Set transactionRows = Union(transactionRows, Sheet2.Range("B" & j))
                End If
            Next j
            
            '创建新邮件
            Set EmailItem = EmailApp.CreateItem(olMailItem)
            EmailItem.To = "abc@gmail.com"
            '优化邮件主题，明确账户和交易数量
            EmailItem.Subject = "#" & accountNum & " - 可疑交易通知（共" & transactionRows.Count & "笔）"
            
            '构建邮件正文开头
            htmlBody = "尊敬的客户：" & "<br>" & "<br>" & _
                       "我们检测到您账户（" & "<b>" & Sheet2.Range("G" & i).Value & " - " & Sheet2.Range("H" & i).Value & "</b>" & "）存在多笔可疑交易，详情如下：" & "<br>" & "<br>" & _
                       "------交易摘要-------" & "<br>" & "<br>" & _
                       "<table border='1' cellspacing='0' cellpadding='4'>"
            
            '循环添加每笔交易到正文表格
            For Each cell In transactionRows
                htmlBody = htmlBody & _
                           "<tr><td><b> 交易ID: </b></td><td>" & Sheet2.Range("C" & cell.Row).Value & "</td><td>" & Sheet2.Range("M" & cell.Row).Value & "</td></tr>" & _
                           "<tr><td><b> 交易金额: </b></td><td>" & Sheet2.Range("K" & cell.Row).Value & "</td><td>" & Sheet2.Range("T" & cell.Row).Value & " " & Sheet2.Range("W" & cell.Row).Value & "</td></tr>" & _
                           "<tr><td><b> 交易日期: </b></td><td>" & Sheet2.Range("J" & cell.Row).Value & "</td><td>" & Sheet2.Range("U" & cell.Row).Value & "</td></tr>"
                '标记当前行为已处理
                Sheet2.Range("Z" & cell.Row).Value = "已处理"
            Next cell
            
            '完成邮件正文收尾
            htmlBody = htmlBody & "</table>" & "<br>" & "<br>" & _
                       "感谢您的理解与配合" & "<br>" & "此致，" & "<br>" & "敬上"
            EmailItem.HTMLBody = htmlBody
            
            '添加该账户所有交易对应的附件
            For Each cell In transactionRows
                Dim attachName As String
                attachName = Sheet2.Range("O" & cell.Row).Value
                For Each file In folder.Files
                    If fso.GetBaseName(file.Name) = attachName Then
                        EmailItem.Attachments.Add file.Path
                        Exit For
                    End If
                Next file
            Next cell
            
            '发送邮件
            EmailItem.Send
        End If
    Next i
    
    '释放占用的对象资源
    Set EmailItem = Nothing
    Set EmailApp = Nothing
    Set fso = Nothing
    Set folder = Nothing
    Set transactionRows = Nothing
End Sub

关键修改说明 #

• 账户分组逻辑：遍历B列收集同一账户的所有交易行，用临时列标记已处理行，避免重复发送
• 交易摘要合并：循环同一账户的交易行，逐笔生成表格行并合并到邮件HTML正文
• 多附件添加：遍历同一账户的交易行，根据O列（附件文件名）匹配并添加对应附件
• 主题优化：主题中加入账户编号和交易数量，提升邮件辨识度

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