Vba 第一次进入循环后发送邮件失败

使用Ron de Bruin中的大多数部分，在邮件地址列中运行宏。 宏运行得很好，但只发送

列B中的第一个点击，并且在我尝试观看时不显示任何其他点击？可能是什么问题

代码是这样的，我可以从outlook获得默认签名，这就是为什么它是
。在代码中首先显示

Sub mail_HTML()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And _
       LCase(Cells(cell.Row, "C").Value) = "yes" Then

strbody = "<H3>Hei " & Cells(cell.Row, "E").Value & "</H3>" _
             & "<p>" & Range("k4") & "<p>"

         On Error Resume Next
        With OutMail
            .Display
            .To = cell.Value
            .Subject = Range("K12").Value
            .HTMLBody = strbody & .HTMLBody
            'You can add files also like this
            '.Attachments.Add Range("O1").Value
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
    End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub 

Sub-mail_HTML（）
“有关提示，请参阅：http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
“2000-2016年在办公室工作
Dim OutApp作为对象
将邮件变暗为对象
暗淡单元格作为范围
像弦一样暗的链子
Set-OutApp=CreateObject（“Outlook.Application”）
Set-OutMail=OutApp.CreateItem（0）
关于错误转到清理
对于列（“B”）.Cells.SpecialCells（xlCellTypeConstants）中的每个单元格
如果单元格值像“*@*。？*”和_
LCase（Cells（cell.Row，“C”）.Value）=“yes”然后
strbody=“Hei”和单元格（cell.Row，“E”）值_
&“”&Range（“k4”）和“”
出错时继续下一步
发邮件
.展示
.To=单元格.Value
.Subject=范围（“K12”）.值
.HTMLBody=strbody和.HTMLBody
'您也可以像这样添加文件
'.Attachments.Add范围（“O1”）.值
.发送
以
错误转到0
发送邮件=无
如果结束
下一个细胞
清理：
设置应用程序=无
Application.ScreenUpdating=True
端接头
当您设置

Set OutMail = Nothing

您再也无法访问该对象（因为它已被销毁）。但是你在循环之前设置它。您需要在每个循环中设置它，然后如下所示：

    On Error Resume Next
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .Display
        .To = cell.Value
        .Subject = Range("K12").Value
        .HTMLBody = strbody & .HTMLBody
        'You can add files also like this
        '.Attachments.Add Range("O1").Value
        .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing

因此，在1封电子邮件之后，该项目将被销毁，但由于下一次恢复时出现错误，您不知道

Tried that but it is not working for me, here is my code:
Do Until in_file.EOF
Email_To = in_file!email_address
Email_Bcc = ""
Email_Body = in_file!email_salut & " " & in_file!email_name & ", test this."
Email_Subject = "Email Subject"
Set mail_object = CreateObject("Outlook.Application")
Set mail_single = mail_object.CreateItem(0)

With mail_single
    .Subject = Email_Subject
    .To = Email_To
    .cc = Email_Cc
    .BCC = Email_Bcc
    .Body = Email_Body
    .send
End With

Set mail_object = Nothing
Set mail_single = Nothing

in_file.MoveNext

循环
它失败，因为您在循环中将
OutMail
设置为
Nothing
，但在循环中不会再次激活它。代码不会因为您的
错误而失败，请继续下一行。尝试在循环中设置
OutMail
。@Ambie就是这样！你能不能给我一个提示，说明为什么附件无法加载（是的，我知道我已经删除了它），你应该提出一个新的问题，解决它。只是我懒散这增加了一个EOF的想法，不适用于这个问题。如果使用这种方法，请考虑移动<代码> SETMILYObjase= CreateObject（“Outlook .Apple”）<代码> >代码> >之前，直到iNo.Fiels.EOF和“移动<代码> SET MyLoObjist=＝No.<代码> > <代码>循环< /C>。