Hello,

Hope someone can help here,  I'm trying to modify the following code to use
an automation object so I don't have deal with CRAPPY REFERENCES!  The
reason being is that this will be going on a number of machines that have
different email programs.  This is not going to be a runtime deployment,
just a drag and drop mdb front end.

Anyway, here is the code as it sits using the Outlook object libary;

Sub ImportContactsFromOutlook(ySuppressMessages As Boolean)
On Error GoTo ImportContactsFromOutlook_Err
   Dim iImportCount As Integer
   Dim iUpdatecount As Integer
  Dim rst As DAO.Recordset
  SetDatabase
  Set rst = db.OpenRecordset("FN Contacts")

  ' 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 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
  If iNumContacts <> 0 Then

     For i = 1 To iNumContacts

        If TypeName(objItems(i)) = "ContactItem" Then
           Set c = objItems(i)
           rst.Index = "ContactID"
           rst.Seek "=", c.EntryID
           If rst.NoMatch Then
               rst.AddNew
               rst!ContactID = c.EntryID
               rst!FirstName = c.FirstName
               rst!LastName = c.LastName
               rst!CompanyName = c.CompanyName
               rst!CompanyAddress = c.BusinessAddress
               rst!CompanyCity = c.BusinessAddressCity
               rst!CompanyRegion = c.BusinessAddressState
               rst!CompanyPostal = c.BusinessAddressPostalCode
               rst!CompanyTelephone = c.BusinessTelephoneNumber
               rst!CompanyFax = c.BusinessFaxNumber
               rst!EMail = c.Email1Address
               rst!ContactAddress = c.HomeAddress
               rst!contactcity = c.HomeAddressCity
               rst!ContactRegion = c.HomeAddressState
               rst!Contactpostal = c.HomeAddressPostalCode
               rst!ContactTelephone = c.HomeTelephoneNumber
               rst!ContactFax = c.HomeFaxNumber
               rst!JobTitle = c.JobTitle

               rst.Update
               iImportCount = iImportCount + 1
            Else
               Dim yUpdated
               rst.Edit
               If c.EntryID <> rst!ContactID Then rst!ContactID =
c.EntryID: yUpdated = True
               If c.FirstName <> rst!FirstName Then rst!FirstName =
c.FirstName: yUpdated = True
               If c.LastName <> rst!LastName Then rst!LastName =
c.LastName: yUpdated = True
               If c.CompanyName <> rst!CompanyName Then rst!CompanyName =
c.CompanyName: yUpdated = True
               If c.BusinessAddress <> rst!CompanyAddress Then
rst!CompanyAddress = c.BusinessAddress: yUpdated = True
               If c.BusinessAddressCity <> rst!CompanyCity Then
rst!CompanyCity = c.BusinessAddressCity: yUpdated = True
               If c.BusinessAddressState <> rst!CompanyRegion Then
rst!CompanyRegion = c.BusinessAddressState: yUpdated = True
               If c.BusinessAddressPostalCode <> rst!CompanyPostal Then
rst!CompanyPostal = c.BusinessAddressPostalCode: yUpdated = True
               If c.BusinessTelephoneNumber <> rst!CompanyTelephone Then
rst!CompanyTelephone = c.BusinessTelephoneNumber: yUpdated = True
               If c.BusinessFaxNumber <> rst!CompanyFax Then rst!CompanyFax
= c.BusinessFaxNumber: yUpdated = True
               If c.Email1Address <> rst!EMail Then rst!EMail =
c.Email1Address: yUpdated = True
               If c.HomeAddress <> rst!ContactAddress Then
rst!ContactAddress = c.HomeAddress: yUpdated = True
               If c.HomeAddressCity <> rst!contactcity Then rst!contactcity
= c.HomeAddressCity: yUpdated = True
               If c.HomeAddressState <> rst!ContactRegion Then
rst!ContactRegion = c.HomeAddressState: yUpdated = True
               If c.HomeAddressPostalCode <> rst!Contactpostal Then
rst!Contactpostal = c.HomeAddressPostalCode: yUpdated = True
               If c.HomeTelephoneNumber <> rst!ContactTelephone Then
rst!ContactTelephone = c.HomeTelephoneNumber: yUpdated = True
               If c.HomeFaxNumber <> rst!ContactFax Then rst!ContactFax =
c.HomeFaxNumber: yUpdated = True
               If c.JobTitle <> rst!JobTitle Then rst!JobTitle =
c.JobTitle: yUpdated = True
               rst.Update
               If yUpdated Then iUpdatecount = iUpdatecount + 1

            End If
           End If
     Next i
     rst.Close
       If iImportCount > 0 Then
           If Not ySuppressMessages Then MsgBox iImportCount & " Contacts
imported successfully.", vbInformation, "Imported Successfully!"
       Else
           If Not ySuppressMessages Then MsgBox "No new contacts were
found.", vbInformation, "No New Contacts"
       End If
  Else
     If Not ySuppressMessages Then MsgBox "No contacts to import.",
vbInformation, "No Contacts Available"
  End If
ImportContactsFromOutlook_Exit:
   'strImpMsg = strImpMsg & vbCrLf & iImportCount & " Mail Message" &
IIf(iImportCount > 1, "s", Null) & " imported."
   If iImportCount > 0 Or iUpdatecount > 0 Then strImpMsg = strImpMsg &
vbCrLf & iImportCount & " Contact" & IIf(iImportCount > 1 Or iImportCount =
0, "s", Null) & " imported" & vbCrLf & iUpdatecount & " Contact" &
IIf(iUpdatecount > 1 Or iUpdatecount = 0, "s", Null) & " updated"
   Exit Sub

ImportContactsFromOutlook_Err:
   ErrorBox Err.Number, Err.Description, "Importing Contacts"
   Resume ImportContactsFromOutlook_Exit
End Sub

WHen trying to covert it, I get as far as the following;

  Set OL = CreateObject("Outlook.Application")
       Set OLNS = OL.GetNamespace("MAPI")
   Set cf = OLNS.GetDefaultFolder(olFolderContacts)

...and then I get lost, any test code that I've used to step through blows
up no matter what I try to put next.

any ideas?

Thanks!