Excel VBA根据标准通过电子邮件发送每一行 [英] Excel VBA to Email Each Row based on Criteria

问题描述

我正在尝试获取此

因此发送如下电子邮件：

So send Emails that looks like this:

然后像这样结束它：

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

I need it to skip blank email addresses, insert sent into column V when sent and create a new email for each row when there is an email available. The new email needs the specific info related to that individual row. I'm using an adaptation of Ron de Bruin's code but every time I run it nothing happens. I don't get an error message, nothing.

代码：

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

编辑：
我有一个新问题，但不确定是否应该一个新的问题：我运行它，没有停止，但是它不会停止。它只是保持运行状态。当我停止运行它时，我必须重新运行一次，我只是希望它可以自动化。我尝试了几件事，但都无济于事。当我将.display更改为.send时，它仅发送电子邮件主题，而不发送正文，因此我必须不断按'esc'停止宏。

I have a new question but was unsure if i should make a new question: I run it, without the Stop, but then it won't stop. It just stays as running. When i run it with the stop I have to re-run it over an over, I just want it to be automated. I tried several things, none worked. When I change .display to .send it only sends the email subject, not the body and I have to constantly hit 'esc' to stop the macro.

推荐答案

代码不起作用主要是因为for-each循环中的 Set OutMail = Nothing 。但是，由于下一步出错恢复，VBEditor不能告诉您这一点。通常，请尝试将您的代码简化为较小的可行，然后开始使其复杂：

The code did not work mainly because of the Set OutMail = Nothing in the for-each loop. However, the VBEditor could not have told you this, because of the On Error Resume Next. In general, try to simplify your code to something small & workable and then start making it complicated:

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

$之后将什么都没有b $ b

一旦生效，您可以考虑在 If cell.Value 中添加更多条件，并修复 .Body 字符串。

Once it works, you may consider adding more conditions to the If cell.Value and fixing the .Body string.

这篇关于Excel VBA根据标准通过电子邮件发送每一行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！