Updating outlook

[dominicgingras]

I have readed several thread about creating new contact i outlook from Access. I have done some work on a database and I am able to tranfer all my contact to a public folder on the exchange server. But I need something more efficient. Anybody got Idea on how to "update" a contact in outlook?

This is the code I am using right now:

Public Sub ExportContactsTable()

Dim oOutlook As New Outlook.Application
Dim colItems As Items
Dim tblCustomers As Object
Dim upContactId As UserProperty
Dim strMessage As String
Dim nms As Object


'Open the table.
Set tblCustomers = CurrentDb.OpenRecordset("Customers&quot
Set nms = oOutlook.GetNamespace("MAPI&quot

'Get a reference to the Items collection of the contacts folder.
'Set colItems = nms.GetDefaultFolder(olFolderContacts).Items

Set colItems = nms.Folders("Public Folders&quot.Folders("All Public Folders&quot.Folders("Customers&quot.Items


Do Until tblCustomers.EOF
if boolCheckName(Nz(tblCustomers!CompanyName), colItems) then
'Use the Add method of Items collection to fill in the
'fields with the data from the table and then save the new
'item.
With colItems.Add
.FirstName = Nz(tblCustomers!ContactFirstName)
.LastName = Nz(tblCustomers!ContactLastName)
.BusinessAddressStreet = Nz(tblCustomers!BillingAddress)
.BusinessAddressCity = Nz(tblCustomers!City)
.BusinessAddressState = Nz(tblCustomers!Province)
.BusinessAddressPostalCode = Nz(tblCustomers!PostalCode)
.BusinessAddressCountry = Nz(tblCustomers!Country)
.BusinessTelephoneNumber = Nz(tblCustomers!PhoneNumber)
.BusinessFaxNumber = Nz(tblCustomers!FaxNumber)
.CompanyName = Nz(tblCustomers!CompanyName)
.JobTitle = Nz(tblCustomers!ContactTitle)
.OtherTelephoneNumber = Nz(tblCustomers!Otherphone)
'Create a custom field.
Set upContactId = .UserProperties. _
Add("Account Number", olText)

upContactId = Nz(tblCustomers![AccountNumber])

.Save
End With
End If
tblCustomers.MoveNext
Loop
tblCustomers.Close

strMessage = "Your contacts have been successfully exported."
MsgBox strMessage, vbOKOnly, MESSAGE_CAPTION


Set tblCustomers = Nothing
Set oOutlook = Nothing

Exit Sub



End Sub

Function boolCheckName(strName As String, colItems As Items) _
As Boolean

Dim varSearchItem As Variant
Dim strMessage As String

If Len(strName) = 0 Then
strMessage = "This record is missing a full name. "
strMessage = strMessage & "Do you want to add it anyway?"
If MsgBox(strMessage, vbYesNo, MESSAGE_CAPTION) = vbYes Then
boolCheckName = True
Else
boolCheckName = False
End If
Else
'Find the first item that has a FullName equal to strName. If no
'item is found, varSearchItem wil be equal to Nothing.
Set varSearchItem = colItems.Find("[CompanyName] = """ & strName & """&quot
If varSearchItem Is Nothing Then
boolCheckName = True
Else
strMessage = "A contact named " & strName & " already exists. "
strMessage = strMessage & _
"Do you want to add this contact anyway?"

If MsgBox(strMessage, vbYesNo, MESSAGE_CAPTION) = vbYes Then
boolCheckName = True
Else
boolCheckName = False
End If
End If
End If
End Function

 

[dominicgingras]

Give it a last shot for help...