按经理邮箱分组员工数据并批量发送Outlook邮件的技术问询

要实现同一经理的下属数据合并到同一封邮件，核心是按经理邮箱分组收集员工数据，再批量生成邮件。同时可以通过表格列名直接引用数据，替代不稳定的Offset方法。

修改后的完整代码 #

Public Sub EmailManagers()
    Dim objOutlook As Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim tbl As ListObject
    Dim managerDict As Object ' 用字典分组经理和下属数据
    Dim rowNum As Long
    Dim managerEmail As String
    Dim employeeData As String
    Dim bodyContent As String
    
    ' 初始化表格对象和字典
    Set tbl = Sheets("Audit").ListObjects("Table1")
    Set managerDict = CreateObject("Scripting.Dictionary") ' 后期绑定，无需添加引用
    Set objOutlook = Outlook.Application
    
    ' 遍历表格每一行，按经理邮箱分组收集数据
    For rowNum = 1 To tbl.ListRows.Count
        ' 获取当前行的经理邮箱（用列名直接引用，避免Offset）
        managerEmail = tbl.ListColumns("Manager Email").DataBodyRange(rowNum).Value
        
        ' 跳过空邮箱的行
        If managerEmail <> "" Then
            ' 收集需要的员工数据（示例：这里取"员工姓名"和"部门"列，可按需修改）
            employeeData = "员工姓名: " & tbl.ListColumns("员工姓名").DataBodyRange(rowNum).Value & _
                          vbCrLf & "部门: " & tbl.ListColumns("部门").DataBodyRange(rowNum).Value & _
                          vbCrLf & "-------------------------" & vbCrLf
            
            ' 将数据添加到字典：如果邮箱已存在则追加，否则新建条目
            If managerDict.Exists(managerEmail) Then
                managerDict(managerEmail) = managerDict(managerEmail) & employeeData
            Else
                managerDict(managerEmail) = employeeData
            End If
        End If
    Next rowNum
    
    ' 遍历字典，为每个经理创建邮件
    For Each managerEmail In managerDict.Keys
        Set objMail = objOutlook.CreateItem(olMailItem)
        
        objMail.To = managerEmail
        objMail.Subject = "下属员工数据汇总" ' 替换为实际主题
        ' 拼接邮件正文，去掉最后多余的分隔线
        bodyContent = Left(managerDict(managerEmail), Len(managerDict(managerEmail)) - Len(vbCrLf & "-------------------------" & vbCrLf))
        objMail.Body = "以下是您下属的员工数据：" & vbCrLf & vbCrLf & bodyContent
        
        ' 可选：直接发送邮件（替换olSave为olSend）
        objMail.Close (olSave)
        Set objMail = Nothing
    Next managerEmail
    
    ' 释放对象
    Set managerDict = Nothing
    Set tbl = Nothing
    Set objOutlook = Nothing
    
    MsgBox "邮件已全部保存完成！"
End Sub

关键改进点说明 #

• 用字典分组：通过Scripting.Dictionary将同一经理的所有下属数据聚合在一起，避免重复创建邮件。
• 列名直接引用：使用tbl.ListColumns("列名").DataBodyRange(rowNum)获取数据，比Offset更可靠，即使表格列顺序调整也不会出错。
• 批量生成邮件：遍历字典的每个键（经理邮箱），一次性生成包含所有下属数据的邮件，而非每行一封。

使用注意事项 #

1. 如果要直接发送邮件，将objMail.Close (olSave)改为objMail.Send。
2. 按需修改employeeData中的列名和数据格式，适配你的实际表格结构。
3. 若使用早期绑定（代码提示更友好），可添加引用：打开VBA编辑器 → 工具 → 引用 → 勾选Microsoft Scripting Runtime，然后将Dim managerDict As Object改为Dim managerDict As New Dictionary。

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