VB6 Outlook automation

Question

I have a block of code that will send emails using Outlook on the users PC. However when we email a bigger amount, it seems as though outlook isn't working as fast as the application so the application opens outlook sends the first email, but the second time it tries to open outlook but gets errors such as Outlook not available etc. So Outlook is taking to long to do the task while the application is trying to create the object again. I was using DoEvents previously but that doesn't work. Is there anyway to wait for outlook to finish its job Before it continues?

In this scenario outlook is not open yet, it is closed and the vb6 application is opening it.

Answer 1

You can trap Err.Number or Err.Description and generate a message box for the user to click to try again (Resume) or cancel (Exit Sub).

You may loop continually, attempting to create, to avoid user intervention. At some point generate the message box so users know the app is still working.

Edit 2015 05 06 - Maybe something less abstract. VBA but should be generic enough for other languages.

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