时间戳

首页 > 解决方案 > 我如何知道通过 vba excel 发送电子邮件时是否已发送电子邮件并且未关闭

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

问题描述

我有一个生成 Outlook 电子邮件的 vba 代码，当我更改 excel 中的特定列时，会填充必需的收件人、抄送、主题和正文。当发送电子邮件时，我的状态栏更新为“已关闭”，电子邮件已发送标志栏更新为“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

标签： excelvbaoutlook

解决方案

未经测试但可以工作：

循环直到.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

推荐阅读