Hi all
My access database has import/export capabiltiy of contact details
between outlook. The database is getting big now (1000+ contacts) and
so are the outlook address books that have the contacts info in them.
When I export contacts from access to outlook, it takes a long time
because there are so many contacts in the Outlook address book, and it
is checking all of these against the contacts coming in, so as to avoid
duplicates. Can anyones suggest a faster way of checking to see if the
contact already exists in outlook, and so wont be duplicated?
This is how im doing it at the moment
Sub ExportAllContactsToOutlook()
Dim MainContactRST As DAO.Recordset
Set MainContactRST = CurrentDb.OpenRecordset("Contact Details")
'Set up outlook objects
Dim ol As New Outlook.Application
Dim olns As Outlook.Namespace
Dim cf As Outlook.MAPIFolder
Dim c As Outlook.ContactItem
Dim cCheck As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim Prop As Outlook.UserProperty
Set olns = ol.GetNamespace("MAPI")
Set cf = olns.GetDefaultFolder(olFolderContacts)
Set objItems = cf.Items
iNumContacts = objItems.Count
With MainContactRST
.MoveFirst
'Loop through the Contact Details records.
Do While Not .EOF
If iNumContacts <0 Then
For i = 1 To iNumContacts
If TypeName(objItems(i)) = "ContactItem" Then
Set cCheck = objItems(i)
If cCheck.CompanyName = MainContactRST!Company
_
And cCheck.FirstName = MainContactRST!FirstName
_
And cCheck.LastName = MainContactRST!LastName _
And cCheck.JobTitle = MainContactRST!JobTitle
Then
GoTo ContactAlreadyExists
End If
End If
Next i
End If
'Create a new Contact item.
Set c = ol.CreateItem(olContactItem)
'Specify which Outlook form to use.
c.MessageClass = "IPM.Contact"
'Add all items about contact from Access table to Outlook
address book
If MainContactRST!Company <"" Then c.CompanyName =
MainContactRST!Company
If MainContactRST!FirstName <"" Then c.FirstName =
MainContactRST!FirstName
If MainContactRST!MiddleName <"" Then c.MiddleName =
MainContactRST!MiddleName
If MainContactRST!LastName <"" Then c.LastName =
MainContactRST!LastName
If MainContactRST!Title <"" Then c.Title =
MainContactRST!Title
If MainContactRST!Suffix <"" Then c.Suffix =
MainContactRST!Suffix
If MainContactRST!JobTitle <"" Then c.JobTitle =
MainContactRST!JobTitle
