Question

我有一个vba代码，该代码生成一个Outlook电子邮件，当我在excel中更改特定列时，会填充所需的收件人，抄送，主题和正文。发送电子邮件后，我的状态列更新为“已关闭”，电子邮件发送标志列更新为“ 1”。但是问题是当我在我的电子邮件（发送并自动填充）上的“发送”上单击“关闭”时，即使我的状态和“电子邮件已发送”标志列分别更新为“关闭”和“ 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

Answer 1

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

Answer 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

我如何知道通过VBA Excel发送电子邮件时是否已发送但未关闭

2 个答案: