Creating Outlook Contacts From Access

  • Thread starter Thread starter Marco
  • Start date Start date
M

Marco

Can anyone please share code that will create an Outlook
contact based on a record in my table.

I am assuming that I will be using CDO for this but I have
not been able to find any code that explains the procedure.

Any help would be greatly appreciated

Thanks

Marco
 
If I remember correctly, this code comes from a Microsoft KB article.
You'll need, of course, to modify it to use your table, form and field
names.


First, set a reference to the Microsoft Outlook xx.x Object Library, where
xx.x is the version that you are using. Then, put the following code behind
a command button on a form:

Dim oOutlook As New Outlook.Application
Dim colItems As Items
Dim rsCont As Recordset
Dim strSQL As String
Dim strMsg As String

strSQL = "Select * from tblContacts " _
& "WHERE ContactName is not null and EmailAddr is not null;"

Set rsCont = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

'Get a reference to the Items collection of the contacts folder.
Set colItems = oOutlook.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderContacts).Items

Do Until rsCont.EOF
If Not blnIsContact(rsCont!ContactName, colItems) Then
With colItems.Add
.FullName = rsCont!ContactName
.Email1Address = rsCont!emailaddr
.BusinessAddressStreet = rsCont!BusinessAddress
.FullName = rsCont!ContactName
.BusinessAddressCity = rsCont!City
.BusinessAddressState = rsCont!Region
.BusinessAddressPostalCode = rsCont!PostalCode
.BusinessAddressCountry = rsCont!Country
.BusinessTelephonePhone = rsCont!Phone
.BusinessFaxNumber = rsCont!Fax
.CompanyName = rsCont!CompanyName
.JobTitle = rsCont!ContactTitle
.Save
End With
End If
rsCont.MoveNext
Loop
rsCont.Close

MsgBox "Done!"

End Sub
'END OF CODE TO BE COPIED TO COMMAND BUTTON

'PASTE THE FOLLOWING CODE INTO ONE OF YOUR PUBLIC MODULES
Public Function blnIsContact(strName As String, colItems As Items) As
Boolean

Dim varItem As Variant
Dim strMsg As String

'Search for the FullName (strName) in Contacts. If it is found,
'notify the user.
Set varItem = colItems.Find("[FullName] = """ & strName & """")
If varItem Is Nothing Then
blnIsContact = False
Else
strMsg = "The contact named " & strName & " already exists. " _
& Chr(13) & Chr(10) & "Do you want to add this contact
anyway?"

If MsgBox(strMsg, vbYesNo) = vbYes Then
blnIsContact = False
Else
blnIsContact = True
End If
End If

End Function

END OF CODE TO BE COPIED TO PUBLIC MODULE.


hth,
 
Back
Top