asked on

Outlook 2013 Macro - Update Contacts process

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.

Thanks

-------------------------------------------------------

Sub UpdateContactBasedOnEmailDeliveryData()

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
With mai

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.Email1Address) > 0 And InStr(1, .Subject, "deliver", vbTextCompare) Then
olContact.User2 = .Subject
olContact.Save
End If

End If

UserForm1.TextBox1 = "Email " & UpdtCount & " " & .Subject
UserForm1.TextBox2 = "Contact " & UpdtCount1 & " " & olContact.FileAs
UserForm1.Show vbModeless
DoEvents

UpdtCount1 = UpdtCount1 + 1
Next

End With
End If

UpdtCount = UpdtCount + 1
Next

Unload UserForm1

MsgBox "Macro Complete"

End Sub
Delivered-Facility-Condition-Assessments

Alexei Kuznetsov

I suggest you to look at the Folder.GetTable() method. It is orders of magnitude faster than iterating Items collection.

rogerdjr

ASKER

Good idea - I will re-configure and try it out this week.

rogerdjr

ASKER

Tried this code and can't seem to access the contents of the contacts in the line MsgBox .FirstName & vbNewLine & .LastName & vbNewLine & .Email1Address

Get the attached error message - searched the internet for a reference that might help with no success.

Sub zzTestFolderGetTableMethod()
'Declarations
Dim Filter As String
Dim oRow As Outlook.Row
Dim oTable As Outlook.Table

Dim oOlApp As Outlook.Application
Dim objNmSpc As NameSpace
Dim ContFldr As Object

Set oOlApp = Outlook.Application
Set objNmSpc = oOlApp.GetNamespace("MAPI")

MsgBox objNmSpc.GetDefaultFolder(olFolderContacts).FolderPath
Set ContFldr = objNmSpc.GetDefaultFolder(olFolderContacts)

'Define Filter to obtain items last modified after May 1, 2005
Filter = "[User1] = '09-04-2014 - Facility Condition Assessments'"
'Restrict with Filter
Set oTable = ContFldr.GetTable(Filter)

'Enumerate the table using test for EndOfTable
Do Until (oTable.EndOfTable)
Set oRow = oTable.GetNextRow()
With oTable
MsgBox .FirstName & vbNewLine & .LastName & vbNewLine & .Email1Address
End With
Loop
End Sub
zzTestFolderGetTableMethod---error.pdf

Alexei Kuznetsov

This is not the way it works. You need to explicitly provide the required fields using oTable.Columns. See How to: Filter and Efficiently Enumerate Items in a Folder MSDN article for details and sample.

rogerdjr

ASKER

Thanks - I read the article and it was helpful - it appears that the table is read only

The way my original code worked is to:
1) Select an return receipt email with an email address embedded in the text of the body of the email
2) Page through each contact to see if the contact's email address is found in the body of the selected email (using the instr() function)
3) If the contact address is found I would then update the User2. field with the selected email's subject text.

The idea is that when I do an eblast, a bunch of the emails are returned as received and read and a bunch are rejected for one reason or another or are simple deleted and not read. This process would help me evaluate the return emails and fix any problems that are found.

I may be able to use the filter to narrow the search of the contacts decreasing the number with the User2 as blank and doing a subroutine to open and edit each contact. That will take some thought so I'll spend a little time (between projects) this week to sort it out.

Thanks

rogerdjr

ASKER

Update

a very simple process where I'd like to apply a filter and update the contact user4 field for only those existing contacts have an entry in the user4 field, I tried to modify to filter using the Folder.GetTable Method (Outlook) but I can't figure out how to edit the contact row

Sub z09_02_2014_UpdateContact()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.PickFolder

Dim olObject As Object
Dim olContact As Outlook.ContactItem

Dim ContactNo As Integer

ContactNo = 1
For Each olObject In olFolder.Items

If TypeName(olObject) = "ContactItem" Then
Set olContact = olObject

olContact.User4 = ""
olContact.Save

UserForm1.TextBox1 = "Clearing User4 - All Contacts - Contact # " & ContactNo
UserForm1.Show vbModeless
DoEvents
End If
ContactNo = ContactNo + 1
Next
end sub

ASKER CERTIFIED SOLUTION

David Lee

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

rogerdjr

ASKER

An excellent solution thank you very much

Fast and efficient and a good learning experience for me

Thanks

David Lee

You're welcome!