Access VBA实现按国家分组发送Outlook表格邮件需求

核心逻辑 #

先提取数据表中所有不重复的国家及对应收件人，逐个遍历每个国家，筛选该国家的全部记录生成HTML表格，再调用Outlook创建并发送针对性邮件。

完整VBA代码 #

Sub SendGroupedEmailsByCountry()
    Dim db As DAO.Database
    Dim rsCountries As DAO.Recordset
    Dim rsRecords As DAO.Recordset
    Dim olApp As Object
    Dim olMail As Object
    Dim htmlTable As String
    Dim country As String
    Dim recipientEmail As String
    Dim i As Integer
    
    ' 初始化数据库连接
    Set db = CurrentDb()
    
    ' 获取所有唯一国家及对应收件人（需确保DummyTable有RecipientEmail字段存邮箱）
    Set rsCountries = db.OpenRecordset("SELECT DISTINCT Country, RecipientEmail FROM DummyTable ORDER BY Country;")
    
    ' 启动/连接Outlook应用（后期绑定，兼容多版本）
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then Set olApp = CreateObject("Outlook.Application")
    On Error GoTo 0
    
    ' 遍历每个国家分组
    Do While Not rsCountries.EOF
        country = rsCountries!Country
        recipientEmail = rsCountries!RecipientEmail
        
        ' 筛选当前国家的所有记录
        Set rsRecords = db.OpenRecordset("SELECT * FROM DummyTable WHERE Country = '" & Replace(country, "'", "''") & "';")
        
        ' 生成HTML表格
        htmlTable = "<table border='1' cellpadding='4' cellspacing='0' style='border-collapse:collapse;'>"
        ' 添加表头
        htmlTable = htmlTable & "<tr>"
        For i = 0 To rsRecords.Fields.Count - 1
            htmlTable = htmlTable & "<th style='background-color:#f0f0f0;'>" & rsRecords.Fields(i).Name & "</th>"
        Next i
        htmlTable = htmlTable & "</tr>"
        ' 添加数据行
        Do While Not rsRecords.EOF
            htmlTable = htmlTable & "<tr>"
            For i = 0 To rsRecords.Fields.Count - 1
                htmlTable = htmlTable & "<td>" & Nz(rsRecords.Fields(i).Value, "") & "</td>"
            Next i
            htmlTable = htmlTable & "</tr>"
            rsRecords.MoveNext
        Loop
        htmlTable = htmlTable & "</table>"
        
        ' 创建并发送邮件
        Set olMail = olApp.CreateItem(0)
        With olMail
            .To = recipientEmail
            .Subject = "[" & country & "] 记录汇总"
            .HTMLBody = "您好，以下是" & country & "的相关记录：<br><br>" & htmlTable & "<br>此邮件为自动发送。"
            .Send ' 如需预览可改为.Display
        End With
        
        ' 释放当前国家的记录集
        rsRecords.Close
        Set rsRecords = Nothing
        
        rsCountries.MoveNext
    Loop
    
    ' 释放所有资源
    rsCountries.Close
    Set rsCountries = Nothing
    Set db = Nothing
    Set olMail = Nothing
    Set olApp = Nothing
    
    MsgBox "邮件发送完成！", vbInformation
End Sub

关键说明 #

1. 分组逻辑：通过SELECT DISTINCT Country, RecipientEmail确保每个国家只触发一次邮件发送，避免重复操作。
2. SQL安全处理：用Replace(country, "'", "''")转义国家名称中的单引号，防止SQL语法错误。
3. 空值处理：用Nz函数将空字段值转为空字符串，避免表格单元格显示异常。
4. 兼容调整：若需按「国家+城市」分组，只需修改分组SQL为SELECT DISTINCT Country, City, RecipientEmail FROM DummyTable ORDER BY Country, City;，同时筛选条件加入AND City = '...'即可。

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