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
AndrewMcLaughlinAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
will_scarlet7Connect With a Mentor Commented:
Wow! I sure am not thinking well today... I should have deleted the .To line:

Try this:
            .Recipients.Add (sLastEmailAddr)
            .Subject = sSubject
            .Body = strBODY
            If objMessage.Recipients.ResolveAll Then
                .Send
            Else
                .Save
            Endif
0
 
perkcCommented:
Use the .Resolve functionality. I tipically use something like:

Dim myolapp As Object
Dim myitem As Object
Dim mynamespace As NameSpace
Dim myrecipient As Recipient

Set myolapp = CreateObject("Outlook.Application")
Set mynamespace = myolapp.GetNamespace("MAPI")
Set myitem = myolapp.CreateItem(olMailItem)

With myitem
    Set myrecipient = .Recipients.Add("EmailNameHere")
        If Not myrecipient.Resolve Then
        MsgBox "The name you entered was not found in Outlook.", vbOKOnly, "Email Error"
        Exit Sub
        End If
    myrecipient.Type = olTo
    .Subject = "SUBJECTHERE"
    .Body = ""BODYHERE
    .Importance = olImportanceNormal
   
    .Save
    .Send
       
End With
Set myolapp = Nothing


0
 
AndrewMcLaughlinAuthor Commented:



Set objMessage = objOutlook.CreateItem(olMailItem)
            With objMessage
           
     Ok  - I tried to tweak my code, but I get the error "invalid qualifier" which points to the word resolve.

Object message = myitem in perkc code

Here's the code lines I modified..
       
           
            .To = sLastEmailAddr
           
            If Not sLastEmailAddr.Resolve Then
           
            .Subject = sSubject
            .Body = strBODY
            .Save
           
            End If
           
            .Subject = sSubject
            .Body = strBODY
            .Save
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
will_scarlet7Commented:
Andrew,

Basically I think you need to change your ".send" statement. Using the Resolve method suggested by perkc, you could try this:

            With objMessage
                .To = sCurrEmailAddr
                .Subject = sSubject
                .Body = strBODY
                If sCurrEmailAddr.Resolve Then
                    .Send
                Else
                    .Save
                End If
            End With
0
 
will_scarlet7Commented:
The same for your other ".send" statement:

            With objMessage
           
           
           
                .To = sLastEmailAddr
                .Subject = sSubject
                .Body = strBODY
                 If sLastEmailAddr.Resolve Then
                    .Send
                Else
                    .Save
                End If
                'reset
           
           
                sLastEmailAddr = rs!EmailAddr
                sPaymentDate = rs!PaymentDate   'Store payment date of last email address
                dTotal = 0
                strBODY = ""
            End With
0
 
AndrewMcLaughlinAuthor Commented:
Sam,

OK  - so here's my code.  When I run I get the error "INvalid qualifier" with the If sLastEmailAddr.Resolve line highlighted.

Do you know what's wrong here?

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 Currency  ' 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
           
            Stop
           
            Set objMessage = objOutlook.CreateItem(olMailItem)
            With objMessage
           
           
           
            .To = sLastEmailAddr
            .Subject = sSubject
            .Body = strBODY
            If sLastEmailAddr.Resolve Then
            .Send
           
            Else
           
            .Save
            End If
           
           
           
           
           
           
            '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
           
            If sCurrEmailAddr.Resolve Then
            .Send
            Else
            .Save
           
            End If
            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

0
 
AndrewMcLaughlinAuthor Commented:


Another thought on this - is it possible ( if the above can not be made to work) to put a line in the SMError code that says

If the error is of type x ( where x is the error code corresponding to having an invalid e-mail address) then go .Save,   and then return to the recordset to loop through the remaining records?

Thanks,

Andrew
0
 
will_scarlet7Commented:
Sorry Andrew,
I was just copying what had been posted before and had forgotten to double check the syntax. Try this:

            sLastEmailAddr.Resolve
            If sLastEmailAddr.Resolved Then
                .Send
            Else
                .Save
            End If


"Resolved" is the property that is returned by the Resolve method, hence the combination of both above.
0
 
AndrewMcLaughlinAuthor Commented:
Ok thanks - i made those changes but I still get an error message Compile Error:  Invalid Qualifier" with  sLastEmailAddr   highlighted on the line sLastEmailAddr.Resolve.....


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 Currency  ' 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
    'Dim mynamespace As NameSpace
   
    'Set mynamespace = objMessage.GetNamespace("MAPI")





     
     
   
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
            sLastEmailAddr.Resolve
            If sLastEmailAddr.Resolved Then
            .Send
           
            Else
           
            .Save
           
           
           
           
           
           
           
            '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
            sCurrEmailAddr.Resolve
            If sCurrEmailAddr.Resolved Then
            .Send
            Else
            .Save
           
           ' End If
            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
0
 
will_scarlet7Commented:
I think it is because "Resolve" only works on a Recipient object. Try this:

            .To = sLastEmailAddr
            .Subject = sSubject
            .Body = strBODY
            .To.ResolveAll
            If .To.Resolved Then
                .Send
            Else
                .Save
            Endif


If that does not work the we will have to build a Recipient object to resolve instead of the .To. It is not complicated, but since you already have this part, let's try it like it is first.

Sam
0
 
AndrewMcLaughlinAuthor Commented:
hi - that gives me the following...

Complile error: Invalid qualifier  with .to highlighted on the .To.ResolveAll line


Do I need any additional declarations or references aside from those in my code above and the Outlook reference?
0
 
will_scarlet7Commented:
Instead of:
            .To = sLastEmailAddr
            .Subject = sSubject
            .Body = strBODY
            .To.ResolveAll
            If .To.Resolved Then
                .Send
            Else
                .Save
            Endif

Try this:
            .Recipients.Add (sLastEmailAddr)
            .Subject = sSubject
            .Body = strBODY
            .To.ResolveAll
            If objMessage.Recipients.ResolveAll Then
                .Send
            Else
                .Save
            Endif
0
 
AndrewMcLaughlinAuthor Commented:
Tried it -  but it really doesn't like that .To line at all  and I get the same error as before "Invalid Qualifier".....
0
 
perkcCommented:
Sorry but I was out fro a while. Try the following:

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 Currency  ' 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
    Dim objrecip As Outlook.Recipient
    'Dim mynamespace As NameSpace
   
    'Set mynamespace = objMessage.GetNamespace("MAPI")
   
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
                Set objrecip = .Recipient.Add(sLastEmailAddr)
                objrecip.Type = olTo
                .Subject = sSubject
                .Body = strBODY
                If objrecip.Resolve Then
                .Send
                Else
                .Save
                'reset
                sLastEmailAddr = rs!EmailAddr
                sPaymentDate = rs!PaymentDate   'Store payment date of last email address
                dTotal = 0
                strBODY = ""
                End If
            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
                Set objrecip = .Recipients.Add(sCurrEmailAddr)
                objrecip.Type = olTo
                .Subject = sSubject
                .Body = strBODY
                If objrecip.Resolve Then
                .Send
                Else
                .Save
                End If
            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


perkc
0
 
AndrewMcLaughlinAuthor Commented:
Sam - thanks very much for this.

One final thing - you don't know how I can get a Euro symbol in Access do you?

0
 
will_scarlet7Commented:
ThanX Andrew! Sorry it took me so long to get it right.

For the Euro symbol, I think the best way might be through using the ASCII code (€ can be obtained via ASCII by holding down the Alt key and typing 0128 then releasing the Alt key). The site below gives more details on using ASCI codes:

http://www.geocities.com/Athens/Atrium/3005/asciitutor.html

God bless!

Sam
0
All Courses

From novice to tech pro — start learning today.