Help! Trying to change code to use Application Object

[Rico]

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!

[Rico]

Never mind....got it! ;)
"Rico" <r c o l l e n s @ h e m m i n g w a y . c o mREMOVE THIS PART IN
CAPS> wrote in message news:YDBxf.96600$tl.23247@pd7tw3no...

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!