Как узнать, было ли отправлено и не закрыто письмо при отправке через VBA Excel? - PullRequest
Новая
       16

Как узнать, было ли отправлено и не закрыто письмо при отправке через VBA Excel?

0 голосов
/ 24 января 2019

У меня есть код VBA, который генерирует электронное письмо с Outlook, заполняется необходимыми значениями «Кому», «CC», «Тема» и «Тело» при изменении определенного столбца в 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

Ответы [ 2 ]

0 голосов
/ 24 января 2019

Не проверено, но может работать:

Цикл, пока .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
0 голосов
/ 24 января 2019

Вы должны проверить, было ли отправлено сообщение. Существует логическое свойство сообщения с именем Отправлено .

...