等到在 Outlook 中发送电子邮件，然后再移动到下一个单元格行答案

【问题标题】：Wait until email is sent in Outlook before moving to next cell row等到在 Outlook 中发送电子邮件，然后再移动到下一个单元格行
【发布时间】：2020-03-23 13:02:53
【问题描述】：

此 Excel 的 VBA 代码应从每行中的特定单元格获取信息以填充自动电子邮件跟进。

代码在工作表的每一行中移动，并在 Outlook 中打开电子邮件草稿。当工作表有太多行时，这是有问题的，Outlook 通常会崩溃。

我尝试使用各种循环，但它要么破坏脚本，要么导致草稿重新打开，迫使我不得不终止 Outlook。

有没有办法打开草稿并等到窗口关闭或发送后再移动到下一行？

我使用.Display 而不是.Send，以便在发送之前可以查看、编辑或取消电子邮件草稿。

在移动到 Excel 中的新行之前，是否有什么东西会检查 .Display = True？

Sub SendEmails()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim Name As String
    Dim FirstName As String
    Dim LastName As String
    Dim Temp

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

    On Error GoTo cleanup

    For Each cell In Columns("W").Cells.SpecialCells(xlCellTypeConstants)
        i = cell.Row                                                                
        Temp = Split(Sheets("Sheet1").Range("P" & i).Value)                         
        FirstName = WorksheetFunction.Proper(Temp(LBound(Temp)))                   

        If Sheets("Sheet1").Range("A" & i).Value = "Yellow" And Sheets("Sheet1").Range("AE" & i).Value = "Red" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .subject = "Yellow Red" & Sheets("Sheet1").Range("A" & i).Value & " - " & Sheets("Sheet1").Range("D" & i).Value
                .HTMLBody = "<p>Good Afternoon " & FirstName & "," & "</p>" & "<p>Thank you for Yellow.</p>" & "<p> Thanks </p>"
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If

        If Sheets("Sheet1").Range("A" & i).Value = "Blue" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .subject = "Blue" & Sheets("Sheet1").Range("A" & i).Value & " - " & Sheets("Sheet1").Range("D" & i).Value
                .HTMLBody = "<p>Good Afternoon " & FirstName & "," & "</p>" & "<p>Thank you for Blue.</p>" & "<p> Thanks </p>"
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If

        If Sheets("Sheet1").Range("A" & i).Value = "Yellow" And Sheets("Sheet1").Range("AE" & i).Value <> "Red" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .subject = "Yellow" & Sheets("Sheet1").Range("A" & i).Value & " - " & Sheets("Sheet1").Range("D" & i).Value
                .HTMLBody = "<p>Good Afternoon " & FirstName & "," & "</p>" & "<p>Thank you for Yellow .</p>" & "<p> Thanks </p>"
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If

   Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

【问题讨论】：

当你把它改成.Send 你应该没问题。 Outlook 正在崩溃，因为您强制打开这么多窗口。当您更改为.Send 时，UI 处理会减少，您的 Outlook 实例崩溃的可能性也会降低。您当然应该先进行测试（只需将所有电子邮件发送给自己）
您还可以通过切换到ELSE IF 来加快速度，以避免在每个测试中运行循环中的每个值，假设每个单元格应该只针对一个实例返回 TRUE。如果第一个测试是 TRUE，为什么要在接下来的 2 个测试中运行它，知道结果将是 FALSE？
看起来您所有的电子邮件正文都完全相同。为什么不让 body 成为一个变量呢？然后你只需要一个部分来起草电子邮件......
@urdearboy 我将更改为 Else If 语句。这就说得通了。对于电子邮件正文，在我的真实代码中，他们并没有说明这里所说的内容。这是非常具体的输出，所以我只是为了帖子而把它简化了。正如你所说，.Send 应该可以解决问题，但我宁愿关闭草稿，也不愿在前端编辑电子表格

标签： excel vba outlook

【解决方案1】：

未测试

首先，很抱歉回复了答案，由于没有足够的代表，我无法发表评论。好的，我在网上对你的问题做了一些研究，你可能想看看.Display True

似乎在显示中添加“True”会使弹出窗口成为模态。在您点击发送电子邮件之前，处于模态状态会暂停循环。

只是想让你知道这件事，但不能发表评论。

【讨论】：