如何在Excel VBA批量发邮件时忽略空邮箱列值？

你当前的代码会弹出收件人为空的邮件窗口，核心问题是：只有创建邮件对象的操作被包裹在空值判断里，但配置、显示邮件的逻辑在判断外部——即便邮箱为空，依然会执行With OutMail块，要么复用之前的邮件对象设置空收件人，要么触发运行时错误。

你的联系人表格：

原代码：

Sub SendMultipleEmails() 

    Dim OutApp As New Outlook.Application
    Dim OutMail As MailItem

    lr = Cells(Rows.Count, "B").End(xlUp).Row 
    ' Since B is the second row and this list is complete
    msg_1 = "To PRotect the world from devastation?" & vbLf & vbLf
  
    For r = 2 To lr 'To ignore the header

        If Range("A" & r).Value <> "" then Set OutMail = OutApp.CreateItem(olMailItem)

        With OutMail 
            .To = Range("A" & r).Value 
            .Subject = "Team Rocket Chant" 
            .Body = msg_1
            .CC = Range("C" & r).Value 

            .Display
        End With 

    Next r 

    Set OutMail = Nothing 
    Set OutApp = Nothing
End Sub 

修改后的代码：

Sub SendMultipleEmails() 

    Dim OutApp As New Outlook.Application
    Dim OutMail As MailItem
    Dim lr As Long
    Dim r As Long
    Dim msg_1 As String

    lr = Cells(Rows.Count, "B").End(xlUp).Row 
    msg_1 = "To PRotect the world from devastation?" & vbLf & vbLf
  
    For r = 2 To lr ' 跳过表头行
        ' 仅当邮箱列（A列）非空时，才创建并配置邮件
        If Trim(Range("A" & r).Value) <> "" Then
            Set OutMail = OutApp.CreateItem(olMailItem)
            With OutMail 
                .To = Range("A" & r).Value 
                .Subject = "Team Rocket Chant" 
                .Body = msg_1
                .CC = Range("C" & r).Value 

                .Display
            End With
            Set OutMail = Nothing ' 释放当前邮件对象，避免复用
        End If
    Next r 

    Set OutApp = Nothing
End Sub 

关键修改说明：

• 把邮件创建、配置、显示的全流程都放到空值判断If块内，彻底跳过空邮箱的联系人
• 用Trim()过滤单元格内的空格，避免把仅含空格的单元格误判为有效邮箱
• 显式声明所有变量，避免VBA隐式类型转换带来的潜在问题
• 每次处理完一个邮件后立即释放OutMail对象，防止循环中复用旧对象

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