我如何知道通过 vba excel 发送电子邮件时是否已发送且未关闭答案

【问题标题】：How do i know if an email was sent and not closed while sending it through vba excel我如何知道通过 vba excel 发送电子邮件时是否已发送且未关闭
【发布时间】：2019-01-24 19:46:03
【问题描述】：

我有一个 vba 代码，当我更改 excel 中的特定列时，它会生成一封 Outlook 电子邮件，并填充必需的收件人、抄送、主题和正文。当发送电子邮件时，我的状态栏更新为“已关闭”，电子邮件已发送标志栏更新为“1”。但问题是，当我在我的电子邮件（已生成并自动填充）上单击发送上的关闭 instes 时，即使我的状态和电子邮件发送标志列分别更新为已关闭和 1。下面是我的代码。

Private Sub Worksheet_Change(ByVal Target As Range)    
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    Dim html As String
    Dim intR As String
    Dim ccStr As String
    Dim Signature As String
    Dim html1 As String
    'Dim itmevt As New CMailItemEvents
    'Dim tsp As String        

    lRow = Cells(Rows.Count, 17).End(xlUp).Row
    lRow1 = ThisWorkbook.Sheets("Validation Lists").Cells(Rows.Count, 4).End(xlUp).Row

    html = "<br>" & ("Hi,") & ("Please spare some time to provide feedback for our service. This will help us to serve you better for upcoming services.") & "<br>"

    For i = 2 To lRow1        
        ccStr = ";" & ThisWorkbook.Sheets("Validation Lists").Cells(i, "D").Value & ccStr
    Next i

    For i = 1 To lRow
        If (Cells(i, "Q").Value = "Closed") And (Cells(i, "R").Value <> "1") Then
            intR = MsgBox("Do you want to send a feedback for " & Cells(i, "B") & "Viz." & Cells(i, "C").Value & " to " & Cells(i, "C") & "?", vbQuestion + vbYesNo)

            If intR = vbYes Then
                Set xOutApp = CreateObject("Outlook.Application")
                Set xMailItem = xOutApp.CreateItem(0)

                With xMailItem
                    .To = Cells(i, "I").Value
                    .CC = ccStr
                    .display
                    Signature = .HTMLBody
                    .Subject = "Feedback for " & Cells(i, "B").Value & " viz. " & Cells(i, "C").Value
                    .HTMLBody = html & "This request was assited by " & Cells(i, "K").Value & "<br><br>" & Signature
                    '.dispaly

                    '.Send
                End With

                Cells(i, "R").Value = "1"
                Set xRgSel = Nothing
                Set xOutApp = Nothing
                Set xMailItem = Nothing
                On Error Resume Next
            End If

            If intR = vbNo Then Cells(i, "Q").Value = "In Progress"     
        End If
    Next i  
End Sub

【问题讨论】：

请注意，您应该删除On Error Resume Next。如果您遇到错误，请修复它们On Error Resume Next 将隐藏所有错误消息，但错误仍然会发生。如果您看不到它们，您将无法修复它们，如果您不修复它们，您的代码将无法工作。
如果您通过按 Outlook 中的发送按钮手动发送电子邮件，我认为 Excel 没有机会检查它是否已发送或关闭。确定你只能让VBA用.Send发送邮件，然后发送。

标签： excel vba outlook

【解决方案1】：

您必须检查消息是否已发送。存在一个boolean message property named Sent。

【讨论】：

【解决方案2】：

未经测试但可以工作：

循环直到.Sent 是True。

With xMailItem
    .To = Cells(i, "I").Value
    .CC = ccStr
    .display
    Signature = .HTMLBody
    .Subject = "Feedback for " & Cells(i, "B").Value & " viz. " & Cells(i, "C").Value
    .HTMLBody = html & "This request was assited by " & Cells(i, "K").Value & "<br><br>" & Signature

    Do Until .Sent = True
       DoEvents
    Loop
End With

【讨论】：