I created this code to page through emails and update the user2 field of the associated contact with the delivery status - basically to identify contacts with inactive email addresses.
the return receipt info has the recipient's email address in the body of the return receipt email
It works fine and when there are just a few emails, paging through each email and then paging all 6,000 contacts in my address book to find the associated contact.
When there are a lot of emails this is a very time consuming process and might work faster if there was a "find Process" rather than paging through each contact.
I'd appreciate any suggestions that you could offer.
Attached is a typical "return receipt email" though content can vary, in each case the email address is in the body of the email I am searching.
Dim mai As MailItem
Dim UpdtCount As Integer, UpdtCount1 As Integer
Dim oOlApp As Outlook.Application
Dim objNmSpc As NameSpace
Dim ofldr As Object
Dim ContFldr As Object
Dim olObject As Object
Dim olContact As Outlook.ContactItem
Dim StrWhere As String
Set oOlApp = Outlook.Application
Set objNmSpc = oOlApp.GetNamespace("MAPI"
MsgBox "Select Email Folder"
Set ofldr = objNmSpc.PickFolder
MsgBox "Select Contacts Folder"
Set ContFldr = objNmSpc.PickFolder
MsgBox "Email Folder - " & ofldr & vbNewLine & "Contacts - " & ContFldr
UpdtCount = 1
For Each mai In ofldr.Items
If mai.Class = olMail Then
UpdtCount1 = 1
For Each olObject In ContFldr.Items
If TypeName(olObject) = "ContactItem" Then
Set olContact = olObject
If InStr(1, .Body, olContact.Email1Address) > 0 And Len(olContact.Email1Addres
s) > 0 And InStr(1, .Subject, "deliver", vbTextCompare) Then
olContact.User2 = .Subject
UserForm1.TextBox1 = "Email " & UpdtCount & " " & .Subject
UserForm1.TextBox2 = "Contact " & UpdtCount1 & " " & olContact.FileAs
UpdtCount1 = UpdtCount1 + 1
UpdtCount = UpdtCount + 1
MsgBox "Macro Complete"