第一次循环后发送邮件失败答案

【问题标题】：failes to send mail after first in loop第一次循环后发送邮件失败
【发布时间】：2016-07-27 10:59:28
【问题描述】：

使用 Ron de Bruin 的大部分部分在包含邮件地址的列中运行一个宏。宏运行得很好，但只发送column B 中的第一个命中并且当我尝试观看它时不显示任何其他命中？可能是什么问题？

代码是为了让我可以从 Outlook 中获取默认签名，这就是为什么它在代码中首先是 .Display。

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

【问题讨论】：

它失败了，因为您在循环中将OutMail 设置为Nothing，但永远不会在循环中再次实例化它。由于您的 On Error Resume Next 行，代码不会失败。尝试在循环中设置OutMail。
@Ambie 就是这样！谢谢
您能否也给我一个提示，说明为什么附件无法加载（是的，我知道我已经删除了它；））
你应该为此提出一个新问题。
想通了。只是我懒

标签： vba excel

【解决方案1】：

当你设置时

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 封电子邮件之后，对象被销毁，但您不知道，因为下一步会出现错误恢复

【讨论】：

【解决方案2】：

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

循环

【讨论】：

这增加了一个不适用于问题的EOF想法。如果你使用这个考虑在Do Until in_file.EOF之前移动Set mail_object = CreateObject("Outlook.Application")，在Loop之后移动Set mail_object = Nothing。