VB6 Outlook自动化

Question

我有一个代码块，将发送电子邮件使用用户的PC上的Outlook。然而，当我们发送更多的邮件时，似乎outlook的工作速度没有应用程序快，所以应用程序打开outlook时会发送第一封电子邮件，但在第二次尝试打开outlook时却出现诸如Outlook不可用等错误。因此，当应用程序再次尝试创建对象时，Outlook需要很长时间才能完成任务。我之前使用的是DoEvents，但它不起作用。有没有必要等到outlook完成它的工作后再继续呢？

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

Answer 1

您可以捕获Err.Number或Err.Description并生成一个消息框，供用户单击以重试(继续)或取消(退出子项)。

您可能会不断地循环，试图创建，以避免用户干预。有时会生成消息框，这样用户就可以知道应用程序仍在运行。

编辑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