如何在VBA遍历Recordset时实现邮件收件人去重？

方案1：从SQL查询源头去重（推荐） #

直接修改查询语句，用DISTINCT关键字过滤重复的Merchandiser，从数据源层面避免重复，后续遍历逻辑无需额外处理，效率最高。

修改后的完整代码：

' 用DISTINCT去重，同时过滤空值
Set rs = db.OpenRecordset("SELECT DISTINCT Merchandiser FROM InSMasterQuery WHERE Merchandiser IS NOT NULL AND Merchandiser <> ''")
With objMail
    .To = "<Email@email.com>"
    ' 提前存好当前用户地址，避免重复调用
    Dim currentUserAddr As String
    currentUserAddr = objOutlookApp.GetNamespace("MAPI").Session.CurrentUser.AddressEntry
    .CC = currentUserAddr
    
    With rs
        If Not (.EOF And .BOF) Then
            Dim Merch As String
            Merch = ""
            Do Until .EOF
                ' 拼接时避免开头出现多余分号
                If Merch = "" Then
                    Merch = ![Merchandiser]
                Else
                    Merch = Merch & ";" & ![Merchandiser]
                End If
                .MoveNext
            Loop
            ' 只有存在其他抄送人时才拼接分号
            If Merch <> "" Then
                .CC = Merch & ";" & currentUserAddr
            End If
            objMail.Display
        End If
    End With
    
    .Subject = "In Season Markdown Request " & strSeason & " From " & Request
    .Body = "The following is a In Season Markdown Request from " & Request & " Using Version " & Mid(Cver, 24, 6)
    .Attachments.Add myWorkbook.FullName
    .Attachments.Add CopyFile.FullName
    .Attachments.Add UploadFile.FullName
    .Send
End With

方案2：VBA代码中用Dictionary去重 #

如果无法修改SQL查询，可在代码里用Scripting.Dictionary记录已添加的人员，快速判断是否重复（无需遍历检查）。

修改后的完整代码：

Set rs = db.OpenRecordset("InSMasterQuery")
With objMail
    .To = "<Email@email.com>"
    Dim currentUserAddr As String
    currentUserAddr = objOutlookApp.GetNamespace("MAPI").Session.CurrentUser.AddressEntry
    .CC = currentUserAddr
    
    ' 初始化Dictionary（后期绑定，无需额外引用）
    Dim uniqueMerch As Object
    Set uniqueMerch = CreateObject("Scripting.Dictionary")
    
    With rs
        If Not (.EOF And .BOF) Then
            Do Until .EOF
                ' 处理Null值和前后空格，避免"假重复"
                Dim merchName As String
                merchName = Trim(Nz(![Merchandiser], ""))
                ' 仅添加非空且未存在的人员
                If merchName <> "" And Not uniqueMerch.Exists(merchName) Then
                    uniqueMerch.Add merchName, merchName
                End If
                .MoveNext
            Loop
            ' 把去重后的人员转成分号分隔的字符串
            If uniqueMerch.Count > 0 Then
                .CC = Join(uniqueMerch.Keys, ";") & ";" & currentUserAddr
            End If
            objMail.Display
        End If
    End With
    
    .Subject = "In Season Markdown Request " & strSeason & " From " & Request
    .Body = "The following is a In Season Markdown Request from " & Request & " Using Version " & Mid(Cver, 24, 6)
    .Attachments.Add myWorkbook.FullName
    .Attachments.Add CopyFile.FullName
    .Attachments.Add UploadFile.FullName
    .Send
End With

额外注意点 #

• 优先选择方案1，数据库层面去重比代码处理更高效，尤其当记录集数据量较大时。
• 处理空值和空格是必要的，避免邮件CC字段出现无效的空地址或多余分号。
• 将重复调用的currentUserAddr存为变量，减少重复操作提升代码效率。

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