Recreating the Flatfile Tables of Access and Outlook Data

If you have recently entered new contact data or modified existing contact records, either in Access or Outlook, click Yes to refresh the data in the tables that will be compared. Clicking Yes calls two procedures that clear tblOutlookContacts and tblAccessContacts and fill them with up-to-date data. The ImportOutlookContacts procedure (listed next) is simpler: it copies data from all the contact items in the selected folder to records in tblOutlookContacts:

Public Function ImportOutlookContacts() 'Called from cmdForms_Click on fmnuMain

On Error GoTo ErrorHandler

Set appOutlook = GetObject(, "Outlook.Application")

Dim fldContacts As Outlook.Folder Dim con As Outlook.Contactltem Dim strSQL As String Dim strTable As String

Set appOutlook = GetObject(, "Outlook.Application") Set nms = appOutlook.GetNamespace("MAPI")

Set a variable to the Contacts folder to use when synchronizing:

Use the following lines to import from the default local Contacts folder.

'Set fldContacts = nms.GetDefaultFolder(olFolderContacts) 'GoTo ImportData

Use the following section of code to allow selection of a custom Contacts folder from the Folder Picker dialog.

SelectContactFolder:

Set fldContacts = nms.PickFolder If fldContacts Is Nothing Then strTitle = "Select Folder"

strPrompt = "Please select a Contacts folder" MsgBox strPrompt, vbExclamation + vbOKOnly, strTitle GoTo SelectContactFolder End If

Debug.Print "Default item type: " & _

fldContacts.DefaultltemType If fldContacts.DefaultltemType <> olContactltem Then MsgBox strPrompt, vbExclamation + vbOKOnly, strTitle GoTo SelectContactFolder End If

Debug.Print fldContacts.Items.Count & " items in " _ & fldContacts.Name & " folder"

Clear the table of Outlook contact data of old records:

ImportData:

strTable = "tblOutlookContacts" strSQL = "DELETE * FROM " & strTable DoCmd.SetWarnings False DoCmd.RunSQL strSQL

Set dbs = CurrentDb

Set rstTarget = dbs.OpenRecordset(strTable)

Iterate through contacts in the selected Contacts folder and import them to the Access table, setting each field in the target table with the value of a field in the current contact item:

For Each itm In fldContacts.Items If itm.Class = olContact Then Set con = itm rstTarget.AddNew With con rstTarget![CustomerID] = Nz(.CustomerID) rstTarget![Title] = Nz(.Title) rstTarget![FirstName] = Nz(.FirstName) rstTarget![MiddleName] = Nz(.MiddleName) rstTarget![LastName] = Nz(.LastName) rstTarget![Suffix] = Nz(.Suffix) rstTarget![Nickname] = Nz(.Nickname) rstTarget![CompanyName] = Nz(.CompanyName) rstTarget![Department] = Nz(.Department) rstTarget![JobTitle] = Nz(.JobTitle)

rstTarget![BusinessAddressStreet] = _

Nz(.BusinessAddressStreet) rstTarget![BusinessAddressPostOfficeBox] =

Nz(.BusinessAddressPostOfficeBox) rstTarget![BusinessAddressCity] = _

Nz(.BusinessAddressCity) rstTarget![BusinessAddressState] = _

Nz(.BusinessAddressState) rstTarget![BusinessAddressPostalCode] = _

Nz(.BusinessAddressPostalCode) rstTarget![BusinessAddressCountry] = _

Nz(.BusinessAddressCountry) rstTarget![BusinessHomePage] = _

Nz(.BusinessHomePage) rstTarget![FTPSite] = Nz(.FTPSite) rstTarget![HomeAddressStreet] = _

Nz(.HomeAddressStreet) rstTarget![HomeAddressPostOfficeBox] = _

Nz(.HomeAddressPostOfficeBox) rstTarget![HomeAddressCity] = _

Nz(.HomeAddressCity) rstTarget![HomeAddressState] = _

Nz(.HomeAddressState) rstTarget![HomeAddressPostalCode] = _

Nz(.HomeAddressPostalCode) rstTarget![HomeAddressCountry] = _

Nz(.HomeAddressCountry) rstTarget![OtherAddressStreet] = _

Nz(.OtherAddressStreet) rstTarget![OtherAddressPostOfficeBox] = _

Nz(.OtherAddressPostOfficeBox) rstTarget![OtherAddressCity] = _

Nz(.OtherAddressCity) rstTarget![OtherAddressState] = _

Nz(.OtherAddressState) rstTarget![OtherAddressPostalCode] = _

Nz(.OtherAddressPostalCode) rstTarget![OtherAddressCountry] = _

Nz(.OtherAddressCountry) rstTarget![AssistantTelephoneNumber] = _

Nz(.AssistantTelephoneNumber) rstTarget![BusinessFaxNumber] = _

Nz(.BusinessFaxNumber) rstTarget![BusinessTelephoneNumber] = _

Nz(.BusinessTelephoneNumber) rstTarget![Business2TelephoneNumber] = _

Nz(.Business2TelephoneNumber) rstTarget![CallbackTelephoneNumber] = _

Nz(.CallbackTelephoneNumber) rstTarget![CarTelephoneNumber] = _ Nz(.CarTelephoneNumber)

rstTarget![CompanyMainTelephoneNumber] = _

Nz(.CompanyMainTelephoneNumber) rstTarget![HomeFaxNumber] = _

Nz(.HomeFaxNumber) rstTarget![HomeTelephoneNumber] = _

Nz(.HomeTelephoneNumber) rstTarget![Home2TelephoneNumber] = _

Nz(.Home2TelephoneNumber) rstTarget![ISDNNumber] = Nz(.ISDNNumber) rstTarget![MobileTelephoneNumber] = _

Nz(.MobileTelephoneNumber) rstTarget![OtherFaxNumber] = _

Nz(.OtherFaxNumber) rstTarget![OtherTelephoneNumber] = _

Nz(.OtherTelephoneNumber) rstTarget![PagerNumber] = Nz(.PagerNumber) rstTarget![PrimaryTelephoneNumber] = _

Nz(.PrimaryTelephoneNumber) rstTarget![RadioTelephoneNumber] = _

Nz(.RadioTelephoneNumber) rstTarget![TTYTDDTelephoneNumber] = _

Nz(.TTYTDDTelephoneNumber) rstTarget![TelexNumber] = Nz(.TelexNumber) rstTarget![Account] = Nz(.Account) rstTarget![AssistantName] = Nz(.AssistantName)

Use special handling for a date field (a blank date in Outlook is actually a date of 1/1/4501):

If .Birthday <> #1/1/4501# Then rstTarget![Birthday] = .Birthday End If

If .Anniversary <> #1/1/4501# Then rstTarget![Anniversary] = .Anniversary End If

If .LastModificationTime <> #1/1/4501# Then rstTarget![LastUpdated] = _ .LastModificationTime

End If rstTarget![Categories] = Nz(.Categories) rstTarget![Children] = Nz(.Children) rstTarget![PersonalHomePage] = _

Nz(.PersonalHomePage) rstTarget![Email1Address] = Nz(.Email1Address) rstTarget![Email1DisplayName] = _

Nz(.Email1DisplayName) rstTarget![Email2Address] = Nz(.Email2Address) rstTarget![Email2DisplayName] = _

Nz(.Email2DisplayName) rstTarget![Email3Address] = Nz(.Email3Address) rstTarget![Email3DisplayName] = _

Nz(.Email3DisplayName) rstTarget![GovernmentIDNumber] = _

Nz(.GovernmentlDNumber) rstTarget![Hobby] = Nz(.Hobby) rstTarget![ManagerName] = Nz(.ManagerName) rstTarget![OrganizationalIDNumber] = _

Nz(.OrganizationalIDNumber) rstTarget![Profession] = Nz(.Profession) rstTarget![Spouse] = Nz(.Spouse) rstTarget![WebPage] = Nz(.WebPage) rstTarget![IMAddress] = Nz(.IMAddress)

Use special handling for attachments, calling another procedure:

If .Attachments.Count > 0 Then Set rstTargetAttachments = _

rstTarget![Attachments].Value Call CopyOutlookAttsToAccess(con, _ rstTargetAttachments)

End If rstTarget.Update .Close (olSave) End With End If Next itm rstTarget.Close strTitle = "Outlook table created" strPrompt = "Table of Outlook contact data (" _ & strTable _

& ") created and filled with data from the " _ & fldContacts.Name & " folder" MsgBox strPrompt, vbInformation + vbOKOnly, strTitle

ErrorHandlerExit: Exit Function

ErrorHandler:

'Outlook is not running; open Outlook with CreateObject If Err.Number = 429 Then

Set appOutlook = CreateObject("Outlook.Application") Resume Next Else

& "; Description: " & Err.Description Resume ErrorHandlerExit End If

End Function

If you always synchronize your Access contacts to the same Outlook folder, you can comment out the SelectContactFolder code segment and insert a hard-coded folder path instead; if you want to use the default local Contacts folder, just remove the apostrophe on the line 'Set fldContacts = nms.GetDefaultFolder(olFolderContacts), and either comment out or delete the SelectContactFolder code segment.

The other procedure, CreateDenormalizedContactsTable, is considerably more complex, because it has to take data from five linked tables, creating one record per contact and updating its fields from different tables:

Public Function CreateDenormalizedContactsTable() 'Called from cmdForms_Click on fmnuMain

On Error GoTo ErrorHandler

Dim lngTargetID As Long

Dim strQueryContacts As String

Dim strQueryContactlDs As String

Dim strQueryCompanylDs As String

Dim strQueryContactAddresses As String

Dim strTargetCustomerID As String

Set dbs = CurrentDb strQueryContacts = "qryAccessContacts" strQueryContactlDs = "qryContactlDsPhones" strQueryCompanylDs = "qryCompanylDsPhones" strQueryContactAddresses = "qryContactAddresses"

Clear tables of old data.

DoCmd.SetWarnings False strTable = "tblAccessContacts" strSQL = "DELETE * FROM " & strTable DoCmd.RunSQL strSQL

The rstTarget recordset is based on tblAccessContacts; this is the table to be filled with denormal-ized data. rstSource represents the first table of linked Access data, tblContactInfo. Information from this table is written to matching fields in the target table, with special handling for attachments (see the section on attachments for more information on this topic):

Set rstSource = dbs.OpenRecordset(strQueryContacts, _

dbOpenDynaset) Set rstTarget = dbs.OpenRecordset(strTable, _ dbOpenDynaset)

Do While Not rstSource.EOF

Create one record in the target table per contact, and write company and contact data to it; also create one record in the match table per contact, for use in comparing contacts:

rstTarget.AddNew rstTarget![CustomerID] = Nz(rstSource!CustomerID) strTargetCustomerID = rstTarget![CustomerID] rstTarget![CompanyName] = _ Nz(rstSource!CompanyName) rstTarget![Account] = Nz(rstSource!Account) rstTarget![Categories] = Nz(rstSource!Categories) rstTarget![OrganizationalIDNumber] = _ Nz(rstSource!OrganizationalIDNumber) rstTarget![WebPage] = Nz(rstSource!WebPage) rstTarget![FTPSite] = Nz(rstSource!FTPSite) rstTarget![Title] = Nz(rstSource!Title) rstTarget![FirstName] = Nz(rstSource!FirstName) rstTarget![MiddleName] = Nz(rstSource!MiddleName) rstTarget![LastName] = Nz(rstSource!LastName) rstTarget![Suffix] = Nz(rstSource!Suffix) rstTarget![Nickname] = Nz(rstSource!Nickname) rstTarget![Department] = Nz(rstSource!Department) rstTarget![JobTitle] = Nz(rstSource!JobTitle) rstTarget![AssistantName] = Nz(rstSource!AssistantName) rstTarget![Birthday] = Nz(rstSource!Birthday) rstTarget![Anniversary] = Nz(rstSource!Anniversary) rstTarget![Children] = Nz(rstSource!Children) rstTarget![GovernmentIDNumber] = _ Nz(rstSource!GovernmentIDNumber) rstTarget![Hobby] = Nz(rstSource!Hobby) rstTarget![ManagerName] = Nz(rstSource!ManagerName) rstTarget![Profession] = Nz(rstSource!Profession) rstTarget![Spouse] = Nz(rstSource!Spouse)

Use special handling for attachments, calling another procedure:

Set rstSourceAttachments = _

rstSource![Attachments].Value If rstSourceAttachments.RecordCount > 0 Then Set rstTargetAttachments = _

rstTarget![Attachments].Value Call CopyAccessAttsToAccess(rstSourceAttachments, _ rstTargetAttachments)

Else rstSourceAttachments.Close End If rstTarget![LastUpdated] = Nz(rstSource!LastUpdated) rstTarget.Update rstSource.MoveNext Loop rstSource.Close

The next source object is qryContactlDsPhones (see Figure 11.10). It has only two fields, so to match the many phone and ID fields in the target table I created a query with many calculated fields, one for each phone or ID field in tblAccessContacts.

FIGURE 11.10

A calculated field that converts a phone number in tblContactIDsPhones into a value to be written to tblAccessContacts.

FIGURE 11.10

Each calculated field returns a value for a phone number or ID matching one of the standard Outlook Phone and ID selections; a portion of the code that works with this query is listed below:

Set rstSource = dbs.OpenRecordset(strQueryContactIDs, _ dbOpenDynaset)

Do While Not rstSource.EOF

Search for target record and update Contact ID and phone fields:

strTargetCustomerlD = rstSource![CustomerID] strSearch = "[CustomerlD] = " & Chr$(39) _ & strTargetCustomerlD & Chr$(3 9)

Uncomment the following line to inspect the search string in the Immediate window.

'Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch If rstTarget.NoMatch = False Then

GoTo NextSourceRecordl End If rstTarget.Edit rstTarget![AssistantTelephoneNumber] = _ Nz(rstSource!AssistantTelephoneNumber)

rstTarget![BusinessFaxNumber] = _ Nz(rstSource!BusinessFaxNumber) rstTarget![BusinessTelephoneNumber] = _ Nz(rstSource!BusinessTelephoneNumber) rstTarget![Business2TelephoneNumber] = _ Nz(rstSource!Business2TelephoneNumber) rstTarget![CallbackTelephoneNumber] = _ Nz(rstSource!CallbackTelephoneNumber) rstTarget![CarTelephoneNumber] = _ Nz(rstSource!CarTelephoneNumber) rstTarget![HomeFaxNumber] = _ Nz(rstSource!HomeFaxNumber) rstTarget![HomeTelephoneNumber] = _ Nz(rstSource!HomeTelephoneNumber) rstTarget![Home2TelephoneNumber] = _ Nz(rstSource!Home2TelephoneNumber) rstTarget![ISDNNumber] = Nz(rstSource!ISDNNumber) rstTarget![MobileTelephoneNumber] = _ Nz(rstSource!MobileTelephoneNumber) rstTarget![OtherFaxNumber] = _ Nz(rstSource!OtherFaxNumber) rstTarget![OtherTelephoneNumber] = _ Nz(rstSource!OtherTelephoneNumber) rstTarget![PagerNumber] = Nz(rstSource!PagerNumber) rstTarget![PrimaryTelephoneNumber] = _ Nz(rstSource!PrimaryTelephoneNumber) rstTarget![RadioTelephoneNumber] = _ Nz(rstSource!RadioTelephoneNumber) rstTarget![TTYTDDTelephoneNumber] = _ Nz(rstSource!TTYTDDTelephoneNumber) rstTarget![TelexNumber] = Nz(rstSource!TelexNumber) rstTarget![Email1Address] = _ Nz(rstSource!Email1Address) rstTarget![Email1DisplayName] = _ Nz(rstSource!Email1DisplayName) rstTarget![Email2Address] = _ Nz(rstSource!Email2Address) rstTarget![Email2DisplayName] = _ Nz(rstSource!Email2DisplayName) rstTarget![Email3Address] = _ Nz(rstSource!Email3Address) rstTarget![Email3DisplayName] = _ Nz(rstSource!Email3DisplayName) rstTarget![IMAddress] = Nz(rstSource!IMAddress) rstTarget![PersonalHomePage] = _ Nz(rstSource!PersonalHomePage) rstTarget.Update

NextSourceRecordl:

rstSource.MoveNext Loop rstSource.Close

Company phones and IDs are handled similarly; only one possible value (Company Phone) is synchronized, because that is the only one that matches a field in Outlook:

Set rstSource = dbs.OpenRecordset(strQueryCompanyIDs, _ dbOpenDynaset)

Do While Not rstSource.EOF

Search for target record and update Company Phone field.

strTargetCustomerlD = rstSource![CustomerID] strSearch = "[CustomerlD] = " & Chr$(39) _

& strTargetCustomerlD & Chr$(3 9) 'Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch rstTarget.Edit rstTarget![CompanyMainTelephoneNumber] = _ Nz(rstSource!CompanyMainTelephoneNumber) rstTarget.Update

NextSourceRecord2:

rstSource.MoveNext Loop rstSource.Close

Finally, contact addresses are processed, using a query that converts each address field to the appropriate Business, Home, or Other address field in the target table. Figure 11.11 shows one of the calculated fields in this query.

FIGURE 11.11

A calculated query field that converts StreetAddress to BusinessAddressStreet.

FIGURE 11.11

The rstSource recordset is then selected, based on a query that selects contact addresses; the code looks for a matching target record, and if it is found, it is updated with information from the recordset:

Set rstSource = _

dbs.OpenRecordset(strQueryContactAddresses, _ dbOpenDynaset)

Do While Not rstSource.EOF

strTargetCustomerlD = rstSource![CustomerID] strSearch = "[CustomerlD] = " & Chr$(39) _

& strTargetCustomerlD & Chr$(39) 'Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch rstTarget.Edit rstTarget![BusinessAddressStreet] = _ Nz(rstSource!BusinessAddressStreet) rstTarget![BusinessAddressPostOfficeBox] = _ Nz(rstSource!BusinessAddressPostOfficeBox) rstTarget![BusinessAddressCity] = _ Nz(rstSource!BusinessAddressCity) rstTarget![BusinessAddressState] = _ Nz(rstSource!BusinessAddressState) rstTarget![BusinessAddressPostalCode] = _ Nz(rstSource!BusinessAddressPostalCode) rstTarget![BusinessAddressCountry] = _ Nz(rstSource!BusinessAddressCountry)

rstTarget![HomeAddressStreet] = _ Nz(rstSource!HomeAddressStreet) rstTarget![HomeAddressPostOfficeBox] = _ Nz(rstSource!HomeAddressPostOfficeBox) rstTarget![HomeAddressCity] = _ Nz(rstSource!HomeAddressCity) rstTarget![HomeAddressState] = _ Nz(rstSource!HomeAddressState) rstTarget![HomeAddressPostalCode] = _ Nz(rstSource!HomeAddressPostalCode) rstTarget![HomeAddressCountry] = _ Nz(rstSource!HomeAddressCountry) rstTarget![OtherAddressStreet] = _ Nz(rstSource!OtherAddressStreet) rstTarget![OtherAddressPostOfficeBox] = _ Nz(rstSource!OtherAddressPostOfficeBox) rstTarget![OtherAddressCity] = _ Nz(rstSource!OtherAddressCity) rstTarget![OtherAddressState] = _ Nz(rstSource!OtherAddressState) rstTarget![OtherAddressPostalCode] = _ Nz(rstSource!OtherAddressPostalCode) rstTarget![OtherAddressCountry] = _ Nz(rstSource!OtherAddressCountry) rstTarget.Update

NextSourceRecord3:

rstSource.MoveNext Loop strTitle = "Access table created"

strPrompt = "Denormalized table of Access data ("

& strTable & ") created" MsgBox strPrompt, vblnformation + vbOKOnly, _ strTitle

ErrorHandlerExit: rstSource.Close rstTarget.Close

Exit Function

ErrorHandler:

& "; Description: " & Err.Description Resume ErrorHandlerExit

End Function

The two tables (tblOutlookContacts and tblAccessContacts) have matching fields; they are displayed in subforms on the two forms used for comparing Access and Outlook contact data. Figure 11.12 shows the form that compares contacts by Contact ID (frmCompareContactsByID), with data from an Access contact on the left and the matching Outlook contact (if there is one) on the right.

FIGURE 11.12

A form that compares Outlook and Access contacts by ContactID.

FIGURE 11.12

A form that compares Outlook and Access contacts by ContactID.

Figure 11.13 shows the form that compares contacts by name.

FIGURE 11.13

A form that compares Outlook and Access contacts by name.

FIGURE 11.13

A form that compares Outlook and Access contacts by name.

Copying Contact Data from Access to Outlook (or Vice Versa)

The Select Contact combo box at the top left lets you select a contact, sorted by Contact ID. Figure 11.14 shows the combo box with its list dropped down.

The Select Action combo box on the right side of the header of the form shown in Figure 11.11 offers a different set of choices, depending on whether the Outlook and Access contacts are identical, different, or one is missing, as shown in Table 11.1.

FIGURE 11.14

Selecting a contact by Contact ID.

FIGURE 11.14

Selecting a contact by Contact ID.

Contact Match Status and Actions to Select

Contact Status

Available Actions

Outlook and Access contacts are identical

Go to next contact record

Mark contact for deletion

Copy all Access contacts to Outlook

Copy all Outlook contacts to Access

Outlook and Access contacts are different

Modify Access contact to match Outlook contact

Modify Outlook contact to match Access contact

Go to next contact record

Mark contact for deletion

Copy all Access contacts to Outlook

Copy all Outlook contacts to Access

No Outlook contact

Create new Outlook contact to match Access contact

Go to next contact record

Mark contact for deletion

Copy all Access contacts to Outlook

Copy all Outlook contacts to Access

No Access contact

Create new Access contact to match Outlook contact

Go to next contact record

Mark contact for deletion

Copy all Access contacts to Outlook

Copy all Outlook contacts to Access

To copy data in one field, rather than updating an entire contact record, select either "Access to Outlook" or "Outlook to Access" in the combo box in the center Copy Field Data section of the form, as shown in Figure 11.15, where the value "Vice President" in the Access contact record is being replaced by "Senior Vice President" from the Outlook record. You can also type in new data, or edit existing data, as needed, before copying the record.

FIGURE 11.15

Copying a single field's data from Outlook to Access.

FIGURE 11.15

Copying a single field's data from Outlook to Access.

If you want to completely remove a contact, select "Mark Record for Deletion" and it will be deleted when the contacts are updated. When you have finished copying, editing, and marking records for deletion, the "Update Contact Information" button on the main menu offers you a choice of updating the Access contacts first, and then the Outlook contacts. All data (including attachments, if any) from tblOutlookContacts will be copied back to the contacts in the selected Contacts folder, creating new contacts as needed. The procedure that updates the Outlook contacts is listed here:

Public Sub UpdateAllOutlookContacts()

'Called from cmdUpdateContactInfo_Click() on fmnuMain

On Error GoTo ErrorHandler

Set appOutlook = GetObject(, "Outlook.Application") Set nms = appOutlook.GetNamespace("MAPI") strTable = "tblOutlookContacts" Set dbs = CurrentDb Set rstSource = _

dbs.OpenRecordset(strTable, dbOpenDynaset)

You can use the following lines to export to the default local Contacts folder, or a hard-coded folder of your choice. To use the default Contacts folder, just remove the apostrophe at the beginning of the next line (this is called uncommenting a line of code, because the apostrophe in front of the line turns it into a comment); to use a hard-coded custom folder, enter its name.

'Set fldContacts = nms.GetDefaultFolder(olFolderContacts) 'GoTo UpdateContacts

Use the following section of code to allow selection of a custom Contacts folder from the Folder Picker dialog:

SelectContactFolder: On Error Resume Next

Set fldContacts = nms.PickFolder If fldContacts Is Nothing Then strTitle = "Select Folder"

strPrompt = "Please select a Contacts folder" MsgBox strPrompt, vbExclamation + vbOKOnly, strTitle GoTo SelectContactFolder End If

Debug.Print "Default item type: " _

& fldContacts.DefaultltemType If fldContacts.DefaultltemType <> olContactltem Then MsgBox strPrompt, vbExclamation + vbOKOnly, _

strTitle GoTo SelectContactFolder End If

UpdateContacts:

Do While Not rstSource.EOF

Search for each contact in selected Contacts folder in case it already exists, and set a reference to it, searching first by CustomerID and then by first name and last name (Outlook contacts may lack a value in the CustomerID property):

strCustomerlD = Nz(rstSource![CustomerID]) strSearch = "[CustomerID] = " & Chr$(39) _

& strCustomerID & Chr$(39) Debug.Print "Search string: " & strSearch blnDelete = rstSource![Delete]

Search by CustomerID.

Set con = fldContacts.Items.Find(strSearch) If TypeName(con) = "Nothing" Then

Debug.Print "Customer ID " & strCustomerID _

& " not found in " & fldContacts.Name & " folder" strFirstName = Nz(rstSource![FirstName]) strLastName = Nz(rstSource![LastName]) strSearch = "[FirstName] = " & Chr$(39) _

& strFirstName & Chr$(39) _ & " And [LastName] = " & Chr$(39) _ & strLastName & Chr$(39) 'Debug.Print "Search string: " & strSearch

Search by name.

Set con = fldContacts.Items.Find(strSearch) If TypeName(con) = "Nothing" Then

Debug.Print "Contact name " & strFirstName & " " & strLastName & " not found in " & fldContacts.Name & " folder"

Create new contact item.

Debug.Print "Creating new contact item with " & "CustomerlD " & strCustomerlD If blnDelete = False Then

Set con = fldContacts.Items.Add Else

GoTo NextSourceRecord End If Else

Debug.Print "Found contact name " _ & strFirstName _ & " " & strLastName If blnDelete = True Then con.Delete

GoTo NextSourceRecord End If End If Else

Debug.Print "Found Customer ID " _

& strCustomerID If blnDelete = True Then con.Delete

GoTo NextSourceRecord End If

End If

Update contact item with values from controls on the Outlook subform:

On Error GoTo ErrorHandler con.CustomerID = Nz(rstSource![CustomerID]) con.Title = Nz(rstSource![Title]) con.FirstName = Nz(rstSource![FirstName]) con.MiddleName = Nz(rstSource![MiddleName]) con.LastName = Nz(rstSource![LastName]) con.Suffix = Nz(rstSource![Suffix]) con.Nickname = Nz(rstSource![Nickname])

con.CompanyName = Nz(rstSource![CompanyName]) con.Department = Nz(rstSource![Department]) con.JobTitle = Nz(rstSource![JobTitle]) con.BusinessAddressStreet = _

Nz(rstSource![BusinessAddressStreet]) con.BusinessAddressPostOfficeBox = _

Nz(rstSource![BusinessAddressPostOfficeBox]) con.BusinessAddressCity = _

Nz(rstSource![BusinessAddressCity]) con.BusinessAddressState = _

Nz(rstSource![BusinessAddressState]) con.BusinessAddressPostalCode = _

Nz(rstSource![BusinessAddressPostalCode]) con.BusinessAddressCountry = _

Nz(rstSource![BusinessAddressCountry]) con.BusinessHomePage = _

Nz(rstSource![BusinessHomePage]) con.FTPSite = Nz(rstSource![FTPSite]) con.HomeAddressStreet = _

Nz(rstSource![HomeAddressStreet]) con.HomeAddressPostOfficeBox = _

Nz(rstSource![HomeAddressPostOfficeBox]) con.HomeAddressCity = _

Nz(rstSource![HomeAddressCity]) con.HomeAddressState = _

Nz(rstSource![HomeAddressState]) con.HomeAddressPostalCode = _

Nz(rstSource![HomeAddressPostalCode]) con.HomeAddressCountry = _

Nz(rstSource![HomeAddressCountry]) con.OtherAddressStreet = _

Nz(rstSource![OtherAddressStreet]) con.OtherAddressPostOfficeBox = _

Nz(rstSource![OtherAddressPostOfficeBox]) con.OtherAddressCity = _

Nz(rstSource![OtherAddressCity]) con.OtherAddressState = _

Nz(rstSource![OtherAddressState]) con.OtherAddressPostalCode = _

Nz(rstSource![OtherAddressPostalCode]) con.OtherAddressCountry = _

Nz(rstSource![OtherAddressCountry]) con.AssistantTelephoneNumber = _

Nz(rstSource![AssistantTelephoneNumber]) con.BusinessFaxNumber = _

Nz(rstSource![BusinessFaxNumber]) con.BusinessTelephoneNumber = _

Nz(rstSource![BusinessTelephoneNumber]) con.Business2TelephoneNumber = _

Nz(rstSource![Business2TelephoneNumber])

con.CallbackTelephoneNumber = _

Nz(rstSource![CallbackTelephoneNumber]) con.CarTelephoneNumber = _

Nz(rstSource![CarTelephoneNumber]) con.CompanyMainTelephoneNumber = _

Nz(rstSource![CompanyMainTelephoneNumber]) con.HomeFaxNumber = Nz(rstSource![HomeFaxNumber]) con.HomeTelephoneNumber = _

Nz(rstSource![HomeTelephoneNumber]) con.Home2TelephoneNumber = _

Nz(rstSource![Home2TelephoneNumber]) con.ISDNNumber = Nz(rstSource![ISDNNumber]) con.MobileTelephoneNumber = _

Nz(rstSource![MobileTelephoneNumber]) con.OtherFaxNumber = Nz(rstSource![OtherFaxNumber]) con.OtherTelephoneNumber = _

Nz(rstSource![OtherTelephoneNumber]) con.PagerNumber = Nz(rstSource![PagerNumber]) con.PrimaryTelephoneNumber = _

Nz(rstSource![PrimaryTelephoneNumber]) con.RadioTelephoneNumber = _

Nz(rstSource![RadioTelephoneNumber]) con.TTYTDDTelephoneNumber = _

Nz(rstSource![TTYTDDTelephoneNumber]) con.TelexNumber = Nz(rstSource![TelexNumber]) con.Account = Nz(rstSource![Account]) con.AssistantName = Nz(rstSource![AssistantName]) con.Categories = Nz(rstSource![Categories]) con.Children = Nz(rstSource![Children]) con.PersonalHomePage = _

Nz(rstSource![PersonalHomePage]) con.Email1Address = Nz(rstSource![Email1Address]) con.Email1DisplayName = _

Nz(rstSource![Email1DisplayName]) con.Email2Address = Nz(rstSource![Email2Address]) con.Email2DisplayName = _

Nz(rstSource![Email2DisplayName]) con.Email3Address = Nz(rstSource![Email3Address]) con.Email3DisplayName = _

Nz(rstSource![Email3DisplayName]) con.GovernmentIDNumber = _

Nz(rstSource![GovernmentIDNumber]) con.Hobby = Nz(rstSource![Hobby]) con.ManagerName = Nz(rstSource![ManagerName]) con.OrganizationalIDNumber = _

Nz(rstSource![OrganizationalIDNumber]) con.Profession = Nz(rstSource![Profession]) con.Spouse = Nz(rstSource![Spouse]) con.WebPage = Nz(rstSource![WebPage]) con.IMAddress = Nz(rstSource![IMAddress])

Use special date handling (a blank date in Outlook is actually a date of 1/1/4501):

If Nz(rstSource![Birthday]) <> "" Then con.Birthday = Nz(rstSource![Birthday]) Else con.Birthday = #1/1/4501# End If

If Nz(rstSource![Anniversary]) <> "" Then con.Anniversary = Nz(rstSource![Anniversary]) Else con.Anniversary = #1/1/4501# End If

Use special handling for attachments, calling another procedure:

Set rstSourceAttachments = _

rstSource![Attachments].Value If rstSourceAttachments.RecordCount > 0 Then Call CopyAccessAttsToOutlook(con, _ rstSourceAttachments)

Else rstSourceAttachments.Close End If con.Close (olSave)

strFirstName = "" strLastName = "" strCustomerlD = ""

NextSourceRecord:

rstSource.MoveNext Loop strTitle = "Outlook contacts updated" strPrompt = "All Outlook contacts in the " _

& fldContacts.Name & " folder updated" MsgBox strPrompt, vblnformation + vbOKOnly, _ strTitle

ErrorHandlerExit: Exit Sub

ErrorHandler:

'Outlook is not running; open Outlook with CreateObject If Err.Number = 429 Then

Set appOutlook = CreateObject("Outlook.Application") Resume Next Else

& "; Description: " & Err.Description Resume ErrorHandlerExit End If

End Sub

The UpdateAllAccessContacts procedure has the more complex task of copying updated contact data from tblAccessContacts back to the linked contact tables. This procedure does the reverse of the CreateDenormalizedContactsTable procedure; using tblAccessContacts as a data source, it updates the linked contact data in tblCompanylnfo, tblContactlnfo, tblCompanylDsPhones, tblContactAddresses, and tblContactIDsAndPhones, creating new records as needed:

Public Sub UpdateAllAccessContacts()

'Called from cmdUpdateContactInfo_Click() on fmnuMain

On Error GoTo ErrorHandler

Dim lngContactID As Long Dim lngCompanylD As Long Dim strSourceTable As String Dim strTarget As String Dim strAddressType As String Dim strDescription As String

Set dbs = CurrentDb strSourceTable = "tblAccessContacts"

Set rstSource = dbs.OpenRecordset(strSourceTable, _ dbOpenDynaset)

UpdateCompanylnfo:

Do While Not rstSource.EOF

Debug.Print "Processing Target ID: " _ & rstSource![TargetID]

Search for matching Company record in target table, and update it if found; otherwise, create new company record, and write company data to it.

strTarget = "tblCompanyInfo"

Set rstTarget = dbs.OpenRecordset(strTarget, _

dbOpenDynaset) blnDelete = rstSource![Delete] If blnDelete = True Then

To avoid problems with deleting records in a table on the "one" side of a one-to-many relationship, before updating the tables, the procedure runs three delete queries to delete records linked to contacts marked for deletion:

On Error Resume Next

DoCmd.SetWarnings False DoCmd.OpenQuery "qdelContactIDs" DoCmd.OpenQuery "qdelContactAddresses" DoCmd.OpenQuery "qdelContacts" GoTo NextSourceRecord End If

Next, records in tblCompanyInfo are updated as needed:

On Error GoTo ErrorHandler lngCompanylD = Nz(rstSource![OrganizationalIDNumber]) strSearch = "[CompanylD] = " & lngCompanylD Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch If rstTarget.NoMatch = True Then

Create new company record in target table.

rstTarget.AddNew Else rstTarget.Edit End If rstTarget![CompanyName] = _ Nz(rstSource!CompanyName) rstTarget![Account] = Nz(rstSource!Account) rstTarget![Category] = Nz(rstSource!Categories) rstTarget![WebSite] = Nz(rstSource!WebPage) rstTarget![FTPSite] = Nz(rstSource!FTPSite) rstTarget![LastUpdated] = Now rstTarget.Update rstTarget.Close

Next, records in tblContactInfo are updated as needed: UpdateContactInfo:

Search for matching contact record in target table, and update it if found; otherwise, create a new contact record, and write contact data to it:

strTarget = "tblContactInfo"

Set rstTarget = dbs.OpenRecordset(strTarget, _

dbOpenDynaset) strCustomerID = rstSource![CustomerID] lngContactID = CLng(strCustomerID) strSearch = "[ContactID] = " & lngContactID Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch If rstTarget.NoMatch = True Then

Create a new contact record in the target table.

rstTarget.AddNew rstTarget![CustomerID] = strCustomerID rstTarget![ContactID] = CLng(strCustomerID) Else rstTarget.Edit End If rstTarget![Prefix] = Nz(rstSource!Title) rstTarget![FirstName] = Nz(rstSource!FirstName) rstTarget![MiddleName] = Nz(rstSource!MiddleName) rstTarget![LastName] = Nz(rstSource!LastName) rstTarget![Suffix] = Nz(rstSource!Suffix) rstTarget![Nickname] = Nz(rstSource!Nickname) rstTarget![Department] = Nz(rstSource!Department) rstTarget![JobTitle] = Nz(rstSource!JobTitle) rstTarget![AssistantName] = _ Nz(rstSource!AssistantName) rstTarget![Birthday] = Nz(rstSource!Birthday) rstTarget![Anniversary] = Nz(rstSource!Anniversary) rstTarget![Children] = Nz(rstSource!Children) rstTarget![GovernmentID] = _

Nz(rstSource!GovernmentIDNumber) rstTarget![Hobby] = Nz(rstSource!Hobby) rstTarget![ManagerName] = _ Nz(rstSource!ManagerName) rstTarget![Profession] = Nz(rstSource!Profession) rstTarget![Spouse] = Nz(rstSource!Spouse) rstTarget![LastUpdated] = Now

Special handling for attachments.

Set rstSourceAttachments = _

rstSource![Attachments].Value If rstSourceAttachments.RecordCount > 0 Then Set rstTargetAttachments = _

rstTarget![Attachments].Value Call CopyAccessAttsToAccess(rstSourceAttachments, rstTargetAttachments)

Else rstSourceAttachments.Close End If rstTarget.Update rstTarget.Close

UpdateContactAddresses:

To update data in tblContactAddresses, if there is data in any of the Business address fields, the strAddressType variable is set to Business, and the code searches for matching records in tblContactAddresses. If none are found, a new address record is created; if a record is found, its fields are updated from the appropriate fields in tblAccessContacts. The Home and Other address fields are handled similarly:

strTarget = "tblContactAddresses" Set rstTarget = dbs.OpenRecordset(strTarget, _ dbOpenDynaset)

Update Business address info.

If Nz(rstSource!BusinessAddressStreet) <> "" Or _

Nz(rstSource!BusinessAddressPostOfficeBox) <> "" _ Or Nz(rstSource!BusinessAddressCity) <> "" _ Or Nz(rstSource!BusinessAddressState) <> "" _ Or Nz(rstSource!BusinessAddressPostalCode) <> "" _ Or Nz(rstSource!BusinessAddressCountry) <> "" Then strAddressType = "Business"

strSearch = "[ContactID] = " & IngContactID _ & " And [AddressType] = " & Chr$(39) _ & strAddressType & Chr$(39) Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch If rstTarget.NoMatch = True Then

Create a new contact address record in the target table.

rstTarget.AddNew rstTarget![ContactID] = IngContactID rstTarget![AddressType] = strAddressType Else rstTarget.Edit End If rstTarget![StreetAddress] = _

Nz(rstSource!BusinessAddressStreet) rstTarget![POBox] = _

Nz(rstSource!BusinessAddressPostOfficeBox) rstTarget![City] = _

Nz(rstSource!BusinessAddressCity) rstTarget![StateOrProvince] = _

Nz(rstSource!BusinessAddressState) rstTarget![PostalCode] = _

Nz(rstSource!BusinessAddressPostalCode) rstTarget![Country] = _

Nz(rstSource!BusinessAddressCountry) rstTarget.Update End If

Update Home address info.

If Nz(rstSource!HomeAddressStreet) <> "" _

Or Nz(rstSource!HomeAddressPostOfficeBox) <> "" Or Nz(rstSource!HomeAddressCity) <> "" _ Or Nz(rstSource!HomeAddressState) <> "" _ Or Nz(rstSource!HomeAddressPostalCode) <> "" _ Or Nz(rstSource!HomeAddressCountry) <> "" Then strAddressType = "Home" strSearch = "[ContactID] = " & IngContactID _ & " And [AddressType] = " & Chr$(39) _ & strAddressType & Chr$(39) Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch If rstTarget.NoMatch = True Then

Create a new contact address record in the target table.

rstTarget.AddNew rstTarget![ContactID] = IngContactID rstTarget![AddressType] = strAddressType Else rstTarget.Edit End If rstTarget![StreetAddress] = _

Nz(rstSource!HomeAddressStreet) rstTarget![POBox] = _

Nz(rstSource!HomeAddressPostOfficeBox) rstTarget![City] = _

Nz(rstSource!HomeAddressCity) rstTarget![StateOrProvince] = _

Nz(rstSource!HomeAddressState) rstTarget![PostalCode] = _

Nz(rstSource!HomeAddressPostalCode) rstTarget![Country] = _

Nz(rstSource!HomeAddressCountry) rstTarget.Update

End If

Update Other address info.

If Nz(rstSource!OtherAddressStreet) <> "" _

Or Nz(rstSource!OtherAddressPostOfficeBox) <> "" Or Nz(rstSource!OtherAddressCity) <> "" _ Or Nz(rstSource!OtherAddressState) <> "" _ Or Nz(rstSource!OtherAddressPostalCode) <> "" _ Or Nz(rstSource!OtherAddressCountry) <> "" Then strAddressType = "Other"

strSearch = "[ContactID] = " & IngContactID _ & " And [AddressType] = " & Chr$(39) _ & strAddressType & Chr$(39) Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch If rstTarget.NoMatch = True Then

Create a new contact address record in the target table.

rstTarget.AddNew rstTarget![ContactID] = IngContactID rstTarget![AddressType] = strAddressType Else rstTarget.Edit End If rstTarget![StreetAddress] = _

Nz(rstSource!OtherAddressStreet) rstTarget![POBox] = _

Nz(rstSource!OtherAddressPostOfficeBox) rstTarget![City] = _

Nz(rstSource!OtherAddressCity) rstTarget![StateOrProvince] = _

Nz(rstSource!OtherAddressState) rstTarget![PostalCode] = _

Nz(rstSource!OtherAddressPostalCode) rstTarget![Country] = _

Nz(rstSource!OtherAddressCountry) rstTarget.Update End If rstTarget.Close

UpdateCompanyPhone:

If there is a value in the Company Phone record in the source database, it is written to a record in the target table (this is the only company phone number or ID that can be matched with Outlook, so it is the only one that is synchronized). If none is found, a new record is created and updated with the Company Phone number:

strTarget = "tblCompanyIDsPhones"

Set rstTarget = dbs.OpenRecordset(strTarget, _

dbOpenDynaset) strDescription = "Company Phone" strSearch = "[CompanyID] = " & lngCompanyID _ & " And [Description] = " & Chr$(39) _ & strDescription & Chr$(39) Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch If rstTarget.NoMatch = True Then

Create a new company phone record in the target table. rstTarget.AddNew rstTarget![CompanyID] = lngCompanylD rstTarget![Description] = "Company Phone" Else rstTarget.Edit End If rstTarget![IDOrPhone] = _

Nz(rstSource!CompanyMainTelephoneNumber) rstTarget.Update rstTarget.Close

The Contact IDs and Phones in tblContactIDsPhones are updated in a similar manner: First the code searches for a value in one of these fields, and if it is found, the strDescription variable is set with the phone or ID description, and a record is sought using ContactID and strDescription. If a record is found, it is updated; otherwise a new record is created in tblContactIDsAndPhones and the phone number or ID is written to it:

UpdateContactlDs:

Search for a matching Contact ID record in the target table, and update it if found; otherwise, create a new record, and write Contact ID data to it.

strTarget = "tblContactlDsPhones" Set rstTarget = dbs.OpenRecordset(strTarget, _ dbOpenDynaset)

If Nz(rstSource![AssistantTelephoneNumber]) <> "" Then strDescription = "Assistant Phone" strSearch = "[ContactID] = " & lngContactID _ & " And [Description] = " & Chr$(39) & _ strDescription & Chr$(39) Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch If rstTarget.NoMatch = True Then

Create a new contact ID record in the target table.

rstTarget.AddNew rstTarget![ContactID] = lngContactID rstTarget![Description] = strDescription Else rstTarget.Edit End If rstTarget![IDOrPhone] = _

Nz(rstSource![AssistantTelephoneNumber]) rstTarget.Update End If

If Nz(rstSource![BusinessFaxNumber]) <> "" Then strDescription = "Business Fax" strSearch = "[ContactID] = " & lngContactID _ & " And [Description] = " & Chr$(39) _ & strDescription & Chr$(39) Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch If rstTarget.NoMatch = True Then

Create a new contact ID record in the target table.

rstTarget.AddNew rstTarget![ContactID] = lngContactID rstTarget![Description] = strDescription Else rstTarget.Edit End If rstTarget![IDOrPhone] = _

Nz(rstSource![BusinessFaxNumber]) rstTarget.Update End If

[I am not listing a great number of similar code segments, each of which updates a different phone number or ID.]

If Nz(rstSource![PersonalHomePage]) <> "" Then strDescription = "Web Page"

strSearch = "[ContactID] = " & lngContactID _ & " And [Description] = " & Chr$(39) _ & strDescription & Chr$(39) Debug.Print "Search string: " & strSearch rstTarget.FindFirst strSearch If rstTarget.NoMatch = True Then

Create a new contact ID record in the target table.

rstTarget.AddNew rstTarget![ContactID] = lngContactID rstTarget![Description] = strDescription Else rstTarget.Edit End If rstTarget![IDOrPhone] = _

Nz(rstSource![PersonalHomePage]) rstTarget.Update End If

NextSourceRecord:

rstSource.MoveNext

Loop rstTarget.Close strTitle = "Access tables updated"

strPrompt = "Linked Access tables of contact data " _ & "updated from form"

MsgBox strPrompt, vblnformation + vbOKOnly, strTitle

ErrorHandlerExit:

On Error Resume Next rstSource.Close rstTarget.Close Exit Sub

ErrorHandler:

& "; Description: " & Err.Description Resume ErrorHandlerExit

End Sub

In case you want to copy all the Access contacts to Outlook, or vice versa, there are two selections on the Select Action combo box's list that will let you do this. The "Copy All Access Contacts to Outlook" selection runs the CopyAccessContactsToOutlook procedure, which first puts up a confirmation message to ensure that the user wants to wipe out the existing Outlook contacts, and replace them with contacts copied from Access. If the user clicks Yes, the procedure first calls the CreateDenormalizedContactsTable procedure to write data to tblAccessContacts, and then runs code that is similar to the code in the UpdateAllOutlookContacts procedure, except that it skips the searching and just creates all new Outlook contact items.

Similarly, the "Copy All Outlook Contacts to Access" selection runs the CopyAllOutlook ContactsToAccess procedure, which asks for confirmation, then runs the ImportOutlook Contacts procedure to write data from Outlook contacts to tblOutlookContacts, then runs code that is similar to the code in the UpdateAllAccessContacts procedure, except that it doesn't search for matching records, just creates new Access records for all the Outlook contact records.

When copying all Outlook contacts to Access, you will end up with Access and Outlook contacts whose CustomerlD values don't match. This is because the ContactID field in tblContactlnfo is an AutoNumber field, so it can't be set to a specific value. There are two ways to deal with this discrepancy: Use the Compare by Name form if you don't care whether the Customer ID is the same in Access and Outlook; or select the "Copy All Access Contacts to Outlook" selection to save the Access ContactID AutoNumber value back to the matching Outlook records.

NOTE

0 0

Post a comment