在 Excel 中结束宏

Question

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

原帖在这里Original post

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