Access.2007.VBA.Bibl..

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.DefaultItemType

If fldContacts.DefaultItemType <> olContactItem 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)

Part II Writing VBA Code to Exchange Data between Office Components