基于条件的Excel VBA逐行发送电子邮件

Question

基于条件的Excel VBA逐行发送电子邮件

excelvbaemailoutlook

3

我要做到这个：

发送类似于这样的邮件：

然后让它变成这样：

我需要让它跳过空电子邮件地址，在发送时将其插入到V列中，并在每行有可用电子邮件时为每行创建一个新电子邮件。新电子邮件需要与该行相关的特定信息。我正在使用Ron de Bruin代码的改编，但每次运行它时都没有任何反应。我没有收到错误消息。

代码：

Sub test2()
'Ron De Bruin Adaptation
'Working in Office 2000-2016

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
For Each cell In Columns("T").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And _
       LCase(Cells(cell.Row, "U").Value) <> "Y" _
       And LCase(Cells(cell.Row, "V").Value) <> "send" Then
        With OutMail
            .To = Cells(cell.Row, "T").Value
            .Subject = "New Work Order Assigned"
            .Body = "Work Order: " & Cells(cell.Row, "G").Value & _
                    "has been assigned to you." & _
                    vbNewLine & vbNewLine & _
                    "Region: " & Cells(cell.Row, "B").Value & vbNewLine & _
                    "District: " & Cells(cell.Row, "C").Value & vbNewLine & _
                    "City: " & Cells(cell.Row, "D").Value & vbNewLine & _
                    "Atlas: " & Cells(cell.Row, "E").Value & vbNewLine & _
                    "Notification Number: " & Cells(cell.Row, "F").Value & vbNewLine & _
            .display  'Or use Send
        End With
        On Error GoTo 0
        Cells(cell.Row, "V").Value = "sent"
        Set OutMail = Nothing
    End If
Next cell

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

编辑：

LCase(Cells(cell.Row, "U").Value) <> "Y" 应该改为：

LCase(Cells(cell.Row, "U").Value) = "Y"

编辑： 我有一个新问题，但不确定是否应该提出一个新问题：我运行它，没有停止，它只是一直运行。当我用stop运行它时，我必须一遍又一遍地重新运行它，我只想让它自动化。我尝试了几种方法，但都没有成功。当我将.display更改为.send时，它只发送电子邮件主题，而不是正文，我不得不不断地按“esc”键来停止宏。

- R.E.L.

1

开始按下 F8 键，一步步查看发生了什么。 - Vityata

1

注释掉 On error 行，然后你应该会得到错误信息。 - Harun24hr

这段代码相当无用 - LCase(Cells(cell.Row, "U").Value) <> "Y"，它总是为真。 - Vityata

1

for-each 循环中的 Set OutMail = Nothing 是一个非常糟糕的想法。在下一次迭代中，在 With OutMail 之后它将无法工作。 - Vityata

还在评论您的代码时，这一行 "Notification Number: " & Cells(cell.Row, "F").Value & vbNewLine & _ 不能以 _ 结尾... - Vityata

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Vityata · Accepted Answer

代码主要因为 for-each 循环中的 Set OutMail = Nothing 导致无法正常工作。但由于 On Error Resume Next 的存在，VBEditor 无法告诉您这一点。通常，尝试将代码简化为可行的小型代码，然后再逐步复杂化。

Sub test2()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In Worksheets("Sending").Columns("T").Cells
        Set OutMail = OutApp.CreateItem(0)
        If cell.Value Like "?*@?*.?*" Then      'try with less conditions first
            With OutMail
                .To = Cells(cell.Row, "T").Value
                .Subject = "New Work Order Assigned"
                .Body = "Write something small to debug"
                .display
                Stop                            'wait here for the stop
            End With
            Cells(cell.Row, "V").Value = "sent"
            Set OutMail = Nothing
        End If
    Next cell

    'Set OutApp = Nothing                        'it will be Nothing after End Sub
    Application.ScreenUpdating = True

End Sub

一旦它能够正常工作，您可以考虑添加更多的条件到If cell.Value中，并修复.Body字符串。