Отправьте только одно автоматическое сообщение по электронной почте о любой ошибке - PullRequest
0 голосов
/ 17 октября 2019

У меня есть код для выполнения нескольких задач, и я хотел бы получить уведомление по электронной почте о любой ошибке. Мой текущий код работает нормально, но я заметил, что иногда я получаю 2 или 3 сообщения. Почему так происходит и как это исправить?

Sub PerformAll()

    On Error GoTo ErrorHandler

            Call RefreshQuery
            Call FormatAllCells
            Call BuildListWithClass

            Exit Sub

ErrorHandler:

    If Err <> 0 Then
            Dim objOutlook As Object
            Set objOutlook = CreateObject("Outlook.Application")

            ' CREATE EMAIL OBJECT.
            Dim objEmail As Object
            Set objEmail = objOutlook.CreateItem(olMailItem)

            With objEmail
                .To = "me.you@company.com"
                .Subject = "There was an error with Importer"
                .Body = "Hello Sir, there was an error with Importer. Please take a look!"
                .Send
            End With

            ' CLEAR.
            Set objEmail = Nothing
            Set objOutlook = Nothing
    End If

    Resume Next

End Sub

1 Ответ

0 голосов
/ 18 октября 2019

Похоже, удаление Resume Next сделал работу

Текущий код:

Sub PerformAll()

    On Error GoTo ErrorHandler

            Call RefreshQuery
            Call FormatAllCells
            Call BuildListWithClass

            Exit Sub

ErrorHandler:

    If Err <> 0 Then
            Dim objOutlook As Object
            Set objOutlook = CreateObject("Outlook.Application")

            ' CREATE EMAIL OBJECT.
            Dim objEmail As Object
            Set objEmail = objOutlook.CreateItem(olMailItem)

            With objEmail
                .To = "me.you@company.com"
                .Subject = "There was an error with Importer"
                .Body = "Hello Sir, there was an error with Importer. Please take a look!"
                .Send
            End With

            ' CLEAR.
            Set objEmail = Nothing
            Set objOutlook = Nothing
    End If

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...