Resume next after issue on ItemAdd event

Question

I have the below macro I wrote to get Outlook to insert every email I get into my database. I am having a lot of trouble understanding how error handling is done. I think this breaks when the email is forwarded or deleted due to a rule before the macro can complete or if there is some unsupported character in it.

I know this code is a mess, but can someone please help me understand how to properly handle errors? The goal is: If there is an error on the initial email event, then insert an error message into a secondary errors table in the database. If that fails, just ignore and wait until the next email message.

   Private Sub Items_ItemAdd(ByVal Item As Object)

    Dim conn As ADODB.Connection
    Dim rs As ADODB.recordset
    Dim SQL As String

    Dim emailSubject, fromSender, senderEmail, emailBody, toList, ccList As String
    Dim dateString, timeString As String
    Dim emailReceivedTime As String
    Dim doubleQuotes As String
    doubleQuotes = Chr(34)

    On Error GoTo ErrorHandler
    
    Set conn = New ADODB.Connection
    With conn
        .ConnectionString = "Provider=SQLOLEDB; Data Source = 0.0.0.0; Initial Catalog = Database; User Id = user; Password= pw;"
        .Open
    End With

    Dim Msg As Outlook.MailItem

    On Error GoTo ErrorHandler
    If TypeName(Item) = "MailItem" Then
        On Error GoTo ErrorHandler
        Set Msg = Item
 
        toList = CStr(Msg.To)
        fromSender = CStr(Msg.Sender)
        senderEmail = CStr(Msg.SenderEmailAddress)
        emailSubject = CStr(Msg.Subject)
        emailReceivedTime = CStr(Msg.ReceivedTime)
        emailBody = CStr(Msg.Body)

        Dim cleanedSubject, cleanedBody As String

        cleanedSubject = Replace(emailSubject, "'", " ") 'remove any single quotes because it will break the sql query
        cleanedSubject = Replace(cleanedSubject, doubleQuotes, " ") 'remove double quotes because it will break the vb code below
        cleanedBody = Replace(emailBody, "'", " ")
        cleanedBody = Replace(cleanedBody, doubleQuotes, " ")

        SQL = "INSERT INTO outlook_emails (to_recipients, cc, sender, sender_address, subject_line, body, received_date, received_time) " +
          "SELECT '" + Replace(toList, "'", " ") + "'," +
          "'" + Replace(ccList, "'", " ") + "'," +
          "'" + Replace(fromSender, "'", " ") + "'," +
          "'" + senderEmail + "'," +
          "'" + cleanedSubject + "'," +
          "'" + cleanedBody + "'," +
          "'" + emailReceivedTime + "'," +
          "'" + emailReceivedTime + "'"
 
    Set rs = conn.Execute(SQL)
End If

ProgramExit:
        Exit Sub
        conn.Close
ErrorHandler:
    'MsgBox Err.Number & " - " & Err.Description
    Dim conn2 As ADODB.Connection
    Dim rs2 As ADODB.recordset
    Dim SQLCode As String


    On Error Resume Next
    If TypeName(Item) = "MailItem" Then
        Set Msg = Item
 
        toList = Msg.To
        fromSender = Msg.Sender
        senderEmail = Msg.SenderEmailAddress
        emailSubject = Msg.Subject
        emailReceivedTime = Msg.ReceivedTime
        emailBody = Msg.Body

        cleanedSubject = Replace(emailSubject, "'", " ") 'remove any single quotes because it will break the sql query
        cleanedSubject = Replace(cleanedSubject, doubleQuotes, " ") 'remove double quotes because it will break the vb code below
        cleanedBody = Replace(emailBody, "'", " ")
        cleanedBody = Replace(cleanedBody, doubleQuotes, " ")
    End If

    Set conn2 = New ADODB.Connection
    With conn2
        .ConnectionString = "Provider=SQLOLEDB; Data Source = 0.0.0.0; Initial Catalog = Database; User Id = user; Password= pw;"
        .Open
    End With

    Dim myDate As String
    Dim myTime As String

    myDate = Date
    myTime = Time

    SQLCode = "INSERT INTO error_log (my_date, my_time, hostname, app, error, priority_type) " +
      "SELECT '" + myDate + "'," +
      "'" + myTime + "'," +
      "'" + Environ$("computername") + "'," +
      "'Outlook'," +
      "'" + Err.Description + " - SUBJECT: " + cleanedSubject + "'," +
      "'Low'," +
      "'Outlook Macro Error'"

    On Error Resume Next
    Set rs2 = conn2.Execute(SQLCode)


End Sub

Answer 1

Do your utmost to avoid On Error Resume Next in all situations.

It should be used on as few lines as possible for expected errors. Zero lines is usually best.
https://stackoverflow.com/a/31753321/1571407

How To:
https://stackoverflow.com/a/59550602/1571407

You have to turn the first error handler off before the second can start. https://stackoverflow.com/a/30994055/1571407

Option Explicit

Private Sub test()
    Items_ItemAdd ActiveInspector.CurrentItem
End Sub


Private Sub Items_ItemAdd(ByVal Item As Object)

    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim SQL As String

    Dim emailSubject As String
    Dim fromSender As String
    Dim senderEmail As String
    Dim emailBody As String
    Dim toList As String
    Dim ccList As String
    
    Dim dateString As String
    Dim timeString As String
    Dim emailReceivedTime As String
    
    Dim doubleQuotes As String
    doubleQuotes = Chr(34)

    On Error GoTo ErrorHandler
    
    ' Comment to see a better example
    err.Raise 1     ' Application-defined or object-defined error
        
    If TypeName(Item) = "MailItem" Then
    
        Set conn = New ADODB.Connection
    
        With conn
            ' -2147467259 - [DBNETLIB][ConnectionOpen (Connect()).]SQL Server does not exist or access denied.
            '.ConnectionString = "Provider=SQLOLEDB; Data Source = 0.0.0.0; Initial Catalog = Database; User Id = user; Password= pw;"
                
            ' -2147467259 - [Microsoft][ODBC Driver Manager] Data source name not found and no default driver specified
            .Open
        End With
        
        Dim Msg As Outlook.MailItem
        Set Msg = Item
 
        toList = CStr(Msg.To)
        fromSender = CStr(Msg.Sender)
        senderEmail = CStr(Msg.SenderEmailAddress)
        emailSubject = CStr(Msg.Subject)
        emailReceivedTime = CStr(Msg.ReceivedTime)
        emailBody = CStr(Msg.Body)

        Dim cleanedSubject As String
        Dim cleanedBody As String

        cleanedSubject = Replace(emailSubject, "'", " ") 'remove any single quotes because it will break the sql query
        cleanedSubject = Replace(cleanedSubject, doubleQuotes, " ") 'remove double quotes because it will break the vb code below
        cleanedBody = Replace(emailBody, "'", " ")
        cleanedBody = Replace(cleanedBody, doubleQuotes, " ")
        
        'SQL = ...
        'Set rs = conn.Execute(SQL)
        
        conn.Close

    End If
        
ProgramExit:
    Exit Sub

ErrorHandler:
    Debug.Print "Error updating database."
    Debug.Print " Error number " & err.Number & " - " & err.Description
    
    'Normally
    ' Resume ProgramExit
    ' End Sub
    
    'Normally this would be in ProgramExit
    If Not conn Is Nothing Then
        If conn.State = 1 Then conn.Close
    End If
    
    'Turn off the first error handler
    ' https://stackoverflow.com/a/30994055/1571407
    Resume databaseErrorTable
    
databaseErrorTable:
    
    Dim conn2 As ADODB.Connection
    Dim rs2 As ADODB.Recordset
    Dim SQLCode As String
    
    ' Abandon subsequent invalid processing
    On Error GoTo ErrorHandler2
    
    ' If OERN
    ' - inefficient at best
    ' - hidden errors with mysterious results at worst
    
    ' Comment to see a better example
    err.Raise 3     ' Return without GoSub
    
    If TypeName(Item) = "MailItem" Then
    
        Set conn2 = New ADODB.Connection
        
        With conn2
            '.ConnectionString = "Provider=SQLOLEDB; Data Source = 0.0.0.0; Initial Catalog = Database; User Id = user; Password= pw;"
            .Open
        End With
    
        Set Msg = Item
 
        toList = Msg.To
        fromSender = Msg.Sender
        senderEmail = Msg.SenderEmailAddress
        emailSubject = Msg.Subject
        emailReceivedTime = Msg.ReceivedTime
        emailBody = Msg.Body

        cleanedSubject = Replace(emailSubject, "'", " ") 'remove any single quotes because it will break the sql query
        cleanedSubject = Replace(cleanedSubject, doubleQuotes, " ") 'remove double quotes because it will break the vb code below
        cleanedBody = Replace(emailBody, "'", " ")
        cleanedBody = Replace(cleanedBody, doubleQuotes, " ")

        Dim myDate As String
        Dim myTime As String
    
        myDate = Date
        myTime = Time
    
        'SQLCode = ...
        'Set rs2 = conn2.Execute(SQLCode)
        
        conn2.Close
        
    End If
    
    Exit Sub
    
ErrorHandler2:
    Debug.Print "Error updating database error table."
    Debug.Print " Error number " & err.Number & " - " & err.Description
    
    If Not conn2 Is Nothing Then
        If conn2.State = 1 Then conn2.Close
    End If
    
End Sub