Outlook Automation - Handling errors - What happens if the e-mail address you're sending to doesn't exist

Hi,

I have the following code :  it reads a recordset (tblEmails) and sends out e-mails to the e-maisl names in that record set.

I want to handle this error:  if an e-mail is created where the address is not recognized then I want the code,  instead of just giving the error message, e-mail address not recognized and stopping the code, to put that particular e-mail in outlook draft and then continue to loop through the rest of the recordset.

Can anyone help me with this?  The code below works great up until that point and I've doen a live trial.  However I want to send out about 1000 e-mail tomorrow and if the code simply exits when an e-mail address is not correct that will give me a very long day indeed.

Thanks,

Andrew



Public Function SendAutoEmailUK1FIX() As Boolean




    Dim rs As DAO.Recordset
    Dim db As Database
    Dim strBODY As String
    Dim sSubject As String
    Dim sLastEmailAddr As String
    Dim sCurrEmailAddr As String
    Dim dTotal As Double  ' Not sure if this is the most appropriate data type for this variable????
    Dim sPaymentDate As String
    Dim objOutlook As New Outlook.Application
    Dim objMessage As MailItem

     
   

    On Error GoTo SMError

    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT EmailAddr,SheetNo,PaymentDate,PERSONAL_REFERENCE,AMOUNT FROM tblEmails")         'Open a recordset and read all the emails.
       

   
    sLastEmailAddr = ""
    sPaymentDate = ""
    dTotal = 0

    'Loop
    Do While Not rs.EOF

        'Note the current email addr
        sCurrEmailAddr = rs!EmailAddr
        sSubject = "Automated Expenses Remittance Advice " '& rs!PERSONAL_REFERENCE
       
        'If last email address different to current email address
        'Check for not null becuz first time in loop it will differ
        If sLastEmailAddr <> "" And sLastEmailAddr <> sCurrEmailAddr Then
       
            'Okay, change of email address, lets send the email address
           
            strBODY = "This e-mail is to notify you that on " & sPaymentDate & " a BACS transfer was made to reimburse you for the expense claims listed below.  Please allow three working days from this date, inclusive, for the money to reach your bank account." & vbCrLf & vbCrLf & "Please note that details of your expenses are available on your KnowledgeNet home page.  Any queries should be directed to your practice administrator." & vbCrLf & strBODY & vbCrLf & vbCrLf & "Total Amount Paid GBP £" & dTotal
   
            'SendMsg sLastEmailAddr, sSubject, strBODY HEREHEREHERE
           
            Set objMessage = objOutlook.CreateItem(olMailItem)
            With objMessage
           
           
           
            .To = sLastEmailAddr
            .Subject = sSubject
            .Body = strBODY
            .Send
            'reset
           
           
            sLastEmailAddr = rs!EmailAddr
            sPaymentDate = rs!PaymentDate   'Store payment date of last email address
            dTotal = 0
            strBODY = ""
            End With
   
           
        End If
       
        'Build Body text, one line reading in ref and amount
        strBODY = strBODY & vbCrLf & "Sheet No: " & rs!SheetNo & vbTab & "Amount: " & rs!Amount & "      "
       
        dTotal = dTotal + rs!Amount
       
        sLastEmailAddr = sCurrEmailAddr
        sPaymentDate = rs!PaymentDate   'Store payment date of last email address
       
        'Move to next record
        rs.MoveNext
       
        'Check for eof - if so, send off the last lot
        If rs.EOF = True Then
       
       

            strBODY = "This e-mail is to notify you that on " & sPaymentDate & " a BACS transfer was made to reimburse you for the expense claims listed below.  Please allow three working days from this date, inclusive, for the money to reach your bank account." & vbCrLf & vbCrLf & "Please note that details of your expenses are available on your KnowledgeNet home page.  Any queries should be directed to your practice administrator." & vbCrLf & strBODY & vbCrLf & vbCrLf

            strBODY = strBODY & vbCrLf & vbCrLf & "Total Amount Paid GBP £ " & dTotal
           
           
            '''SendMsg sCurrEmailAddr, sSubject, strBODY  HEREHEREHERE
            Set objMessage = objOutlook.CreateItem(olMailItem)
            With objMessage
            .To = sCurrEmailAddr
            .Subject = sSubject
            .Body = strBODY
            .Send
            End With
           
        End If
    Loop
   
    'Close and clear all
    rs.Close
    Set rs = Nothing
    Set db = Nothing

    SendAutoEmailUK1FIX = True
    Exit Function

SMError:
    MsgBox "A problem occurred." & vbCrLf & Err.Description, vbCritical, "Email"
   
       SendAutoEmailUK1FIX = False
       
       
End Function