Question

使用来自 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

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

Answer 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

循环

failes在第一次循环后发送邮件

2 个答案: