在 Excel 中结束宏

Question

所以，我从用户 Vityata 的 Ron de Bruin 那里得到了这段代码的帮助，但是一旦宏用完 WO 和电子邮件，我就无法让宏停止运行。如果我在 .send 之后输入"停止"，我必须一遍又一遍地单击运行，直到发送所有电子邮件并且所有内容都标记为"已发送"，然后在最后一个电子邮件上它不会停止运行，直到我点击转义。我想找到一种方法，一旦没有更多的工作订单(与尚未发送的电子邮件配对(可以通过电子邮件发送，代码就会停止运行。如果有一种方法还可以在 2018 年工作表的一列中注明已读回执，那将非常有帮助，但我一直在苦苦挣扎。我习惯于在 VBA 中创建表单，因此信息流出对我来说一直很难自动化。

原始帖子

在这里 原始帖子

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("2018").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 = "Work Order: " & Cells(cell.Row, "G").Value & " 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
            .ReadReceiptRequested = True
            .OriginatorDeliveryReportRequested = True
            .Send
        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

编辑：我尝试使用Do Loop功能，但没有运气

Answer 1

问题是您遍历 T 列中的所有单元格，因为范围Worksheets("2018").Columns("T").Cells包含完整的列。

在 sub 的开头添加以下代码

Dim lastRow As Long
Dim ws As Worksheet

    Dim rg As Range
    Set ws = Worksheets("2018")
    With ws
        lastRow = .Cells(Rows.Count, "T").End(xlUp).Row
        Set rg = Range(.Cells(1, "T"), .Cells(lastRow, "T"))
    End With

并将 for 循环更改为

For Each cell In rg

rg仅包含 T 列的填充单元格。这样，代码仅通过包含数据的单元格运行。

PS 根据评论中的信息，您需要像这样对条件进行编码

If cell.Value Like "?*@?*.?*" And UCASE(cell.Offset(0, 1).Value) <> "SENT" Then