VB6 Outlook automation - vba

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