VB6 Outlook 自动化

Question

我有一段代码可以在用户 PC 上使用 Outlook 发送电子邮件。但是，当我们发送大量电子邮件时，似乎 Outlook 的运行速度不如应用程序那么快，因此应用程序打开 Outlook 会发送第一封电子邮件，但第二次尝试打开 Outlook 但会出现诸如 Outlook 不可用等错误. 因此，当应用程序尝试再次创建对象时，Outlook 需要很长时间才能完成任务。我以前使用DoEvents，但这不起作用。无论如何要等待 Outlook 完成其工作，然后再继续？

在这种情况下，outlook 尚未打开，它已关闭，vb6 应用程序正在打开它。

Answer 1

您可以捕获 Err.Number 或 Err.Description 并生成一个消息框供用户单击以重试（Resume）或取消（Exit Sub）。

您可以不断循环，尝试创建，以避免用户干预。有时会生成消息框，以便用户知道该应用仍在运行。

Edit 2015 05 06 - 也许不那么抽象。 VBA，但对于其他语言应该足够通用。

Option Explicit

Private Sub errorHandler_429()

Dim uErrorMsg1 As String
Dim uErrorMsg As String
Dim errCount As Long

uErrorMsg1 = "Click OK to try again."

On Error GoTo ErrorHandler

restart:

    ' code that triggers an error here
    Err.Raise 429   ' <-- For testing
    'Err.Raise 430   ' <--- For testing

ExitRoutine:

    Exit Sub

ErrorHandler:

    Select Case Err.Number

    Case 429

        errCount = errCount + 1

        uErrorMsg = Err.Number & ": " & Err.Description & " occurred " & errCount & " times."

        Debug.Print uErrorMsg

        If (errCount Mod 200) = 0 Then
            uErrorMsg = uErrorMsg1 & vbCr & vbCr & _
                "Error # " & Err.Number & " was generated by " & _
                Err.Source & Chr(13) & Chr(13) & Err.Description

            Debug.Print uErrorMsg

            If MsgBox(uErrorMsg, vbOKCancel, "errorHandler_429", Err.HelpFile, Err.HelpContext) = vbOK Then
                Resume restart
            Else
                Resume ExitRoutine
            End If

        Else
            Resume restart

        End If

    Case Else

        uErrorMsg = Err.Number & ": " & Err.Description
        'Debug.Print uErrorMsg

        MsgBox uErrorMsg, , "errHandler_429", Err.HelpFile, Err.HelpContext
        Resume ExitRoutine

    End Select

End Sub

Sub errHandler_Description()

' Where the error number is negative and inconsistent

Dim uErrorMsg1 As String
Dim uErrorMsg As String
Dim errCount As Long

Dim LErrDesc As String

uErrorMsg1 = "Click OK to try again."

On Error GoTo ErrorHandler

restart:

    ' code that triggers an error here
    Err.Raise 429  ' <--- For testing
    'Err.Raise 430   ' <--- For testing


ExitRoutine:
    Exit Sub

ErrorHandler:

    LErrDesc = Left(Err.Description, 51)
    Debug.Print " LErrDesc: " & LErrDesc

    Select Case LErrDesc

    Case "ActiveX component can't create object"

        errCount = errCount + 1
        Debug.Print " errCcount: " & errCount

        If (errCount Mod 200) = 0 Then
            uErrorMsg = uErrorMsg1 & vbCr & vbCr & _
                "Error # " & Err.Number & " was generated by " & _
                Err.Source & Chr(13) & Chr(13) & Err.Description

            'Debug.Print uErrorMsg

            If MsgBox(uErrorMsg, vbOKCancel, "errHandler_Description", Err.HelpFile, Err.HelpContext) = vbOK Then
                Resume restart
            Else
                Resume ExitRoutine
            End If

        Else
            Resume restart

        End If

    Case Else

        uErrorMsg = "This error has not been handled."
        uErrorMsg = uErrorMsg & vbCr & vbCr & _
            "Error # " & Err.Number & " was generated by " & _
            Err.Source & Chr(13) & Chr(13) & Err.Description

        Debug.Print uErrorMsg
        MsgBox uErrorMsg, , "errHandler_Description", Err.HelpFile, Err.HelpContext

        Resume ExitRoutine

    End Select

End Sub