I have sent emails to a number of employment agencies and some of the addresses are old and invalid. I get a non-deliverable message back which quotes the invalid email address in the body of the message. I want to extract this email address, search through my list of agencies, find the contact with that email address and delete the contact:
[vba]Sub addrcheck()
Dim myolApp As Outlook.Application
Dim toDelete As Object
Dim olAgencies As AddressList
Dim olAgency As ContactItem
Dim objNS As NameSpace
Dim regEx, Match, Matches
Dim olMessage As MailItem
Dim olInbox as MAPIFolder
Set myolApp = CreateObject("Outlook.Application")
Set objNS = myolApp.GetNamespace("mapi")
Set myFolders = objNS.Folders
Set olContacts = objNS.AddressLists
Set olInbox = objNS.GetDefaultFolder(olFolderInbox)
Set regEx = New RegExp ' Create a regular expression.
For Each Item In olContacts
If Item.Name = "Agencies" Then
Set olAgencies = Item
Exit For
End If
Next
'The Collect folder within Inbox is where the returned emails are stored
For Each Item In olInbox.Folders
If Item.Name = "Collect" Then
Set toDelete = Item
Exit For
End If
Next
toDelete.Display
'This displays the "Collect" folder correctly
'Set the email regex pattern
regEx.Pattern = "^[A-Za-z0-9_\.-]+@[A-Za-z0-9_\.-]+[A-Za-z0-9_][A-Za-z0-9_]$"
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = True ' Set global applicability.
For Each olMessage In toDelete
'Extract the email address
Set Match = regEx.Execute(Item.Body) ' Execute search.
For Each olAgency In olAgencies
'** This is where I get the error "Object doesn't support this property
'or method"**
If olAgency.Email1Address = Match Then
olAgency.Display
' olAgency.Delete
End If
Next
Next
End Sub[/vba]
I am unable to discover why I'm getting the error message at this point in the program. Can anyone see why?
[uvba].[/uvba]
~Oorang
Reply With Quote
