Excel含空间隔邮箱列表的循环邮件发送问题求助

看起来你遇到的核心问题是循环发送邮件时，一执行.send语句程序就停了，没法继续处理下一个邮箱地址。这种情况通常是未处理的运行时错误或者CDO对象没有正确重置导致的，我来帮你一步步解决：

可能的原因&对应解决方案 #

1. 未捕获发送时的错误 #

当发送邮件遇到无效邮箱、SMTP连接失败这类问题时，如果没有错误处理机制，VBA会直接终止程序。你需要添加错误捕获逻辑，让程序即使出错也能继续循环。

2. CDO对象没有每次循环重置 #

如果在循环外只创建一次CDO.Message对象，发送完一封邮件后对象的状态可能残留，导致下一次发送失败。建议每次循环都新建一个对象，用完后及时释放。

3. 空单元格未正确跳过 #

你的邮箱列表有空单元格间隔，循环时如果没判断单元格是否为空，会尝试发送空邮箱地址，触发错误终止程序。

修改后的完整代码示例 #

Private Sub CommandButton1_Click()
    Dim myMail As CDO.Message
    Dim Login_EmailAddress, Login_EmailPassword, SMTPServer As String
    Dim ServerPort As Integer
    Dim To_Email, CC_Email, BCC_Email, Email_Subject, Email_Body, Attachment_Path As String
    Dim CustomerEmail As String
    Dim finalrow As Integer
    Dim i As Integer
    
    ' 配置SMTP信息（根据你的邮箱服务商填写）
    Login_EmailAddress = "你的邮箱地址"
    Login_EmailPassword = "你的邮箱密码/授权码"
    SMTPServer = "smtp.xxx.com" ' 比如smtp.gmail.com
    ServerPort = 465 ' 或者587，根据服务商要求
    
    ' 获取邮箱列表的最后一行
    finalrow = ThisWorkbook.Sheets("birthdaymail").Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 开启错误捕获，出错时继续执行下一次循环
    On Error Resume Next
    
    ' 循环处理每个邮箱（假设第一行是表头，从第二行开始）
    For i = 2 To finalrow 
        CustomerEmail = Trim(ThisWorkbook.Sheets("birthdaymail").Cells(i, "A").Value)
        
        ' 跳过空单元格
        If CustomerEmail = "" Then
            GoTo NextLoop
        End If
        
        ' 每次循环新建CDO对象
        Set myMail = New CDO.Message
        
        ' 配置邮件内容
        With myMail
            .To = CustomerEmail
            .CC = CC_Email ' 如果需要CC可以赋值
            .BCC = BCC_Email ' 如果需要BCC可以赋值
            .Subject = Email_Subject ' 替换成你的邮件主题
            .TextBody = Email_Body ' 替换成你的邮件内容
            ' 如果有附件，取消下面注释
            '.AddAttachment Attachment_Path
            
            ' 配置SMTP服务器
            With .Configuration.Fields
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = ServerPort
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Login_EmailAddress
                .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Login_EmailPassword
                .Update
            End With
            
            ' 发送邮件
            .Send
            
            ' 检查是否发送出错，记录结果到B列
            If Err.Number <> 0 Then
                ThisWorkbook.Sheets("birthdaymail").Cells(i, "B").Value = "发送失败：" & Err.Description
                Err.Clear ' 清除错误状态，不影响下一次循环
            Else
                ThisWorkbook.Sheets("birthdaymail").Cells(i, "B").Value = "发送成功"
            End If
        End With
        
        ' 释放CDO对象
        Set myMail = Nothing
        
NextLoop:
    Next i
    
    ' 关闭错误捕获
    On Error GoTo 0
    
    MsgBox "邮件发送任务完成！"
End Sub

关键修改点说明 #

• 加入了On Error Resume Next捕获错误，发送后检查Err.Number判断是否成功，并用Err.Clear清除错误状态，确保下一次循环不受影响。
• 每次循环都新建CDO.Message对象，发送完成后用Set myMail = Nothing释放资源，避免对象状态残留。
• 增加了空单元格判断If CustomerEmail = "" Then GoTo NextLoop，直接跳过空行，避免无效发送。
• 补充了SMTP配置的完整代码，你需要根据自己的邮箱服务商（比如Gmail、Outlook等）填写对应的SMTP服务器、端口和授权信息。

内容的提问来源于stack exchange，提问作者איתן ביאזוי