I don't see that post. Repost it in this thread.
Hi Ken,
Here's an expaned version of that post:
Is there a way to match MailItem properties with ContactItem properties
using VBA?
I'm trying to use VBA to pull all the messages (actually just the sent and
received date of each message) that belong to a particular contact. For
example, if I have a contact "John Doe" in the Contacts folder, I want code
to find all the dates on which I sent (or received) an email to this
contact.
Outlook must know how to associate a particular contact entry with it's
email messages in the PST. This is evidenced by opening an email message in
the InBox and right-clicking on the "From" header: I can select "Lookup
Contact" from the menu that appears and it will take me to that contact's
entry in the
Contacts folder. What I am trying to do is the same process in reverse.
I keep the contacts in my Access database synchronized with the Outlook
Contact folder with code that runs every time the database is opened - I
upload all the relevant contact info (email address, etc.) and an Entity_ID
(which goes in the "Body" field) to the Outlook Contacts folder. What I
need is a way to pull down all the dates in "Sent" and "Received" fields in
the InBox and Sent Items folder - based on the Entity_ID in the Outlook
Contacts form "Body" field. What I'm trying to do is populate a table that
has all the dates on which an email was sent and/or received to each
contact.
Here's a first crack at it... any help is much appreciated.
Public Sub GetMessages()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim olns As Outlook.Namespace
Dim ola As New Outlook.Application
Dim olfcn, olfsm As Outlook.MAPIFolder
Dim olci As Outlook.ContactItem
Dim olmi As Outlook.MailItem
Dim olit As Outlook.Items
Dim varC, varM As Variant
Dim varEid As Variant
Dim varSent As Variant
Dim strSubject As String
Set olns = ola.GetNamespace("MAPI")
Set olfsm = olns.GetDefaultFolder(olFolderSentMail)
Set olfcn = olns.GetDefaultFolder(olFolderContacts)
Set olit = olfsm.Items
Set olmi = olit.GetLast
For Each varC In olfcn.Items
'loop through each Contact in the Contacts folder that has an Entity_ID
If Not IsNull(varC.Body) And IsNumeric(varC.Body) Then
Debug.Print "varC EntryID = " & varC.EntryID
Debug.Print varC.Email1Address
'Debug.Print "olmi.To = " & olmi.To 'this is not associated with
Entity_ID
'below is what appears in "DisplayAs" in Contacts form, and
should match corresponding olmi.To
Debug.Print _
varC.FirstName & " " & _
varC.LastName & " " & _
varC.Suffix & _
"(" & varC.Email1Address & ")"
'now loop through each MailItem to find messages that belong to each
contact - this does not work properly...
For Each varM In olfsm.Items
'the problem here is finding a way to match the MailItem with the
ContactItem
'the only criteria I can find to match on is "To" (see MailItem
properties)
'I've tried EntryID - but they differ between ContactItem and MailItem
'perhaps if I could get the email address out of the MailItem?
'perhpas I am going about this all wrong?
'If olmi.EntryID = varC.EntryID Then
'If olmi.To = varC.Email1Address Then
If olmi.To = _
varC.FirstName & " " & _
varC.LastName & " " & _
varC.Suffix & _
"(" & varC.Email1Address & ")" _
Then
Debug.Print "found MailItem " & olit.Item(1)
'returns first subject in PST by date ascending (does
not associate with Eintity_ID)
Debug.Print olmi.To
'returns most recent email date sent in PST (does not
associate with Entity_ID)
'code to populate table with MailItem data - this is a rough
draft - needs work
Set rst = db.OpenRecordset("tblEmail")
rst.AddNew
rst!Entity_ID = olci.Body
rst!Sent = DateValue(CDate(varSent))
rst!Received = DateValue(CDate(varReceived))
rst.Update
End If
Next
End If
Next
End Sub
