VBA循环发邮件：实现单封邮件显示全部收件人且单独发送

嘿，我来帮你搞定这个邮件发送的难题！你现在遇到的核心问题是直接给olMail.To加多个邮箱报错，还有想要每封邮件显示所有收件人同时发给每个人对吧？咱们一步步来解决：

先搞懂为啥报错 #

你之前直接加多个邮箱报错，本质是Outlook识别多个收件人的格式不对——多个邮箱必须用; （分号加空格）或者纯分号分隔，比如"张三@xxx.com; 李四@xxx.com"，这样Outlook才能正确解析。

实现你要的效果：显示所有收件人+发送给每个人 #

你有两种选择，看你实际需求：

• 选项1：群发一封邮件（推荐）：所有审核人收到同一封邮件，收件人栏显示全部邮箱，这是最常规的多收件人邮件方式，不用循环发，效率高。
• 选项2：给每个人单独发，但每封邮件都显示所有收件人：这种情况每个人会收到和审核人数一样多的邮件，一般不推荐，但如果你确实需要，可以这么做。

修改后的VBA代码（推荐选项1：群发） #

Sub SendReviewerEmails()
    Dim olApp As Object
    Dim olMail As Object
    Dim reviewer_names As Variant, assigned_to_names As Variant
    Dim allReviewerEmails As String ' 存储所有匹配的审核人邮箱
    Dim i As Integer, j As Integer
    Dim reviwer_strg As String, assigned_to_strg As String
    Dim st1 As String, reviewer_email_id As String
    Dim client_name As String, title As String, due_date As String
    Dim document_location As String, backup_location As String
    
    ' 初始化Outlook应用
    Set olApp = CreateObject("Outlook.Application")
    allReviewerEmails = ""
    
    ' 先收集所有匹配的审核人邮箱
    assigned_to_strg = assigned_to_names(LBound(assigned_to_names))
    For i = LBound(reviewer_names) To UBound(reviewer_names)
        reviwer_strg = reviewer_names(i)
        For j = 6 To 15
            st1 = ThisWorkbook.Sheets("Master").Range("H" & j).Value
            If reviwer_strg = st1 Then
                reviewer_email_id = ThisWorkbook.Sheets("Master").Range("I" & j).Value
                ' 用分号+空格拼接邮箱，保证Outlook能识别
                If allReviewerEmails = "" Then
                    allReviewerEmails = reviewer_email_id
                Else
                    allReviewerEmails = allReviewerEmails & "; " & reviewer_email_id
                End If
                Exit For ' 找到匹配项后跳出内层循环，避免重复查找
            End If
        Next j
    Next i
    
    ' 检查是否找到有效邮箱
    If allReviewerEmails = "" Then
        MsgBox "没找到匹配的审核人邮箱哦！", vbExclamation
        Exit Sub
    End If
    
    ' 创建并发送群发邮件
    Set olMail = olApp.CreateItem(olMailItem)
    With olMail
        .To = allReviewerEmails ' 这里赋值所有邮箱，格式正确就不会报错
        .Subject = "Task for Review;" & client_name & ";" & title
        ' 构建HTML邮件内容
        Dim str1 As String, str2 As String, str3 As String, str4 As String, str5 As String
        str1 = "Dear All, " & "<br>" & "Please see the following for review." & "<br>"
        str2 = "Task : " & title & "<br>" & "Client Name : " & client_name & "<br>" & "Due Date : " & due_date & "<br><br>"
        str3 = "Document Location : " & "<a href=""" & document_location & """>" & document_location & "</a>" & "<br>"
        str4 = "Backup Location : " & "<a href=""" & backup_location & """>" & backup_location & "</a>" & "<br><br>"
        str5 = "Awaiting your Feedback." & "<br>" & "Regards, " & "<br>" & assigned_to_strg
        .HTMLBody = "<BODY style=font-size:10pt;font-family:Verdana>" & str1 & str2 & str3 & str4 & str5 & "</BODY>"
        .Send ' 一键发送，所有审核人都能收到，收件人栏显示全部邮箱
    End With
    
    ' 释放对象，避免内存占用
    Set olMail = Nothing
    Set olApp = Nothing
    MsgBox "邮件发送搞定啦！", vbInformation
End Sub

如果你非要单独发但显示所有收件人（选项2） #

把创建邮件的代码放到循环里，每次都把所有邮箱赋值给.To，代码大概是这样（仅修改循环部分）：

' 先收集好allReviewerEmails之后
For i = LBound(reviewer_names) To UBound(reviewer_names)
    reviwer_strg = reviewer_names(i)
    ' 找到当前审核人的邮箱（用于邮件内单独称呼）
    For j = 6 To 15
        st1 = ThisWorkbook.Sheets("Master").Range("H" & j).Value
        If reviwer_strg = st1 Then
            reviewer_email_id = ThisWorkbook.Sheets("Master").Range("I" & j).Value
            Exit For
        End If
    Next j
    
    ' 创建单独邮件，To栏显示所有收件人
    Set olMail = olApp.CreateItem(olMailItem)
    With olMail
        .To = allReviewerEmails
        .Subject = "Task for Review;" & client_name & ";" & title
        ' 单独称呼当前审核人
        str1 = "Dear " & reviwer_strg & ", " & "<br>" & "Please see the following for review." & "<br>"
        str2 = "Task : " & title & "<br>" & "Client Name : " & client_name & "<br>" & "Due Date : " & due_date & "<br><br>"
        str3 = "Document Location : " & "<a href=""" & document_location & """>" & document_location & "</a>" & "<br>"
        str4 = "Backup Location : " & "<a href=""" & backup_location & """>" & backup_location & "</a>" & "<br><br>"
        str5 = "Awaiting your Feedback." & "<br>" & "Regards, " & "<br>" & assigned_to_strg
        .HTMLBody = "<BODY style=font-size:10pt;font-family:Verdana>" & str1 & str2 & str3 & str4 & str5 & "</BODY>"
        .Send
    End With
Next i

⚠️ 再次提醒：这种方式每个审核人会收到N封邮件（N是审核人数），体验不太好，除非有特殊业务需求，不然优先选选项1。

对你原有代码的小修正 #

你原来的代码里同时写了olMail.To = reviewer_email_id和olMail.Recipients.Add (reviewer_email_id)，这会重复添加收件人，以后要注意去掉其中一个哦！

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