Retrieve List of Bounced Email Addresses from Outlook into Access

[BikeToWork]

A user is sending out a mass mailing through Outlook via Access automation. Many of these email addresses are obsolete and the email will bounce back to Outlook as "undeliverable." The user wants to update his list of email addresses in the application so that he avoids the invalid email addresses for future mailings. Is there any way to get a list of the bounced email addresses from Outlook into Access? The user can put all the bounced emails in a folder, if that helps.

[ADezii]

The following Code will at least give you a listing of all E-Mails that were not deliverable. Other information should be easily extracted by using the Properties of the Outlook Item Object.

Dim outOutlook As New Outlook.Application
Dim outNamespace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
'Dim myDestFolder As Outlook.MAPIFolder
Dim outItems As Outlook.Items
Dim outItem As Object
'Dim strFolderName As String
 
 
Set outNamespace = outOutlook.GetNamespace("MAPI")
Set myInbox = outNamespace.GetDefaultFolder(olFolderInbox)
 
Set outItems = myInbox.Items
 
DoCmd.Hourglass True
 
'Retrieve the Undeliverable E-Mail Subjects
For Each outItem In outItems
  If InStr(outItem.Subject, "Delivery Status Notification (Failure)") > 0 Then
    Debug.Print outItem.Subject
  End If
Next
 
DoCmd.Hourglass False
 
Set outOutlook = Nothing
Set outNamespace = Nothing
Set outItem = Nothing

[BikeToWork]

ADezii, thanks a megabyte. I guess I would use something like outItem.EmailAddress to get the email out of it. Thanks again.

[ADezii]

I am not sure if EMailAddress will work in this context, but if it doesn't, the following Logic should provide an easy solution:

1. Search every E-Mail in the Inbox analyzing its Subject to determine if it was Undeliverable. In my Code example the Search Text Delivery Status Notification (Failure) worked.
2. For each Undeliverable, extract the E-Mail Address from the Body of the E-Mail. From what I have seen it will be enclosed within the first occurrence of '<' and a closing '>'.
3. I would actually write these Undeliverable E-Mail Addresses to a Local table where they would be easily accessible.
4. Do whatever you feel is best and let us know how you make out.
5. Partial Code example follows:
   

   '****************************** CODE INTENTIONALLY OMITTED ******************************
   Dim intFirst As Integer         'Location of first '<'
   Dim intLast As Integer          'Location of first '>' after '<'
   Dim strBody As String           'Will hold Body Text of Undeliverable E-Mail
   Dim strUndlvr                   'Holds the actual Undeliverable E-Mail Address
    
   intFirst = InStr(s, "<")
   intLast = InStr(intFirst + 1, s, ">")
    
   For Each outItem In outItems    'All Items in the Inbox
     If InStr(outItem.Subject, "Delivery Status Notification (Failure)") > 0 Then
       strBody = outItem.Body      'Body of Undeliverable E-Mail
         strUndlvr = Mid$(s, (intFirst + 1), (intLast - intFirst) - 1)     'E-Mail Address
     End If
   Next
   '****************************** CODE INTENTIONALLY OMITTED ******************************
    

[BikeToWork]

ADezii, what is the variable "s" in your code sample? I don't see it declared and am not sure where its value is determined. Thanks for the help.

[ADezii]

My sincere apologies. The Variable s was simply used to simulate Text in the Body of each Undeliverable E-Mail, and to make sure that the Address Extraction Code worked as intended. I am currently at home and do not have Outlook installed and I needed a method to simulate what a typical Body Text may consist of. The proper approach would be:

'****************************** CODE INTENTIONALLY OMITTED ******************************
Dim intFirst As Integer         'Location of first '<'
Dim intLast As Integer          'Location of first '>' after '<'
Dim strBody As String           'Will hold Body Text of Undeliverable E-Mail
Dim strUndlvr                   'Holds the actual Undeliverable E-Mail Address
 
For Each outItem In outItems    'All Items in the Inbox
  If InStr(outItem.Subject, "Delivery Status Notification (Failure)") > 0 Then
    strBody = outItem.Body      'Body of Undeliverable E-Mail
      intFirst = InStr(strBody, "<")
      intLast = InStr(intFirst + 1, strBody, ">")
        strUndlvr = Mid$(strBody, (intFirst + 1), (intLast - intFirst) - 1)     'E-Mail Address
  End If
Next
'****************************** CODE INTENTIONALLY OMITTED ******************************