如何在Excel VBA邮件的.To字段中使用跨工作表命名区域作为收件人列表？

作为编程新手，能想到用命名区域来管理收件人列表真的很赞——这比直接把邮箱地址硬编码在代码里灵活太多，后续维护起来也方便。下面我一步步给你讲怎么把另一个工作表的命名区域整合到你的VBA代码里：

核心思路 #

Outlook的.To字段需要的是用分号（或逗号，取决于你的Outlook设置）分隔的邮箱地址字符串，所以我们要做的就是：

1. 读取目标命名区域里的所有邮箱地址
2. 把这些地址合并成符合要求的字符串
3. 把这个字符串赋值给.To字段

修改后的完整代码 #

你可以直接把下面的代码替换掉你原来的片段，记得根据自己的实际情况修改命名区域的名称：

Private Sub Email_Click()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Dim recipientRange As Range
    Dim recipientStr As String
    Dim cell As Range
    
    On Error Resume Next
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = Range("G2") & " Shift Turnover Report is attached"
    
    ' 1. 获取你的命名区域（替换成你实际的命名区域名称，比如"RecipientList"）
    ' 如果是工作表级命名区域，要写成 Sheet2.Range("你的区域名")
    Set recipientRange = ThisWorkbook.Names("RecipientList").RefersToRange
    
    ' 2. 遍历区域，合并邮箱地址为分号分隔的字符串（跳过空白单元格）
    For Each cell In recipientRange
        If Trim(cell.Value) <> "" Then
            recipientStr = recipientStr & IIf(recipientStr <> "", ";", "") & Trim(cell.Value)
        End If
    Next cell
    
    On Error Resume Next
    With xOutMail
        .To = recipientStr ' 3. 把合并好的收件人字符串赋值给.To
        .Subject = "Shift Turnover Report" ' 建议加个清晰的主题
        .Body = xMailBody
        ' 如果需要自动添加附件，取消下面注释并修改文件路径
        '.Attachments.Add "C:\你的文件路径\ShiftTurnoverReport.xlsx"
        .Display ' 先预览邮件，确认没问题再改成.Send直接发送
    End With
    
    ' 释放对象，避免内存占用
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

几个关键细节提醒 #

• 命名区域的类型：如果你的命名区域是绑定在某个特定工作表上的（工作表级），记得把ThisWorkbook.Names("RecipientList").RefersToRange改成Sheet2.Range("RecipientList")（把Sheet2换成实际的工作表名）。
• 空白单元格处理：代码里加了Trim(cell.Value) <> ""的判断，会自动跳过命名区域里的空白单元格，避免出现多余的分号导致收件人格式错误。
• 预览 vs 直接发送：代码里用的是.Display，会弹出Outlook邮件窗口让你预览，新手建议先这么做，确认收件人、内容都没问题后，再改成.Send实现自动发送。
• Outlook安全提示：第一次运行可能会弹出安全警告，这是Outlook的默认保护机制，你可以在Outlook的信任中心里调整相关设置，或者直接点击允许即可。

内容的提问来源于stack exchange，提问作者N. Benedict