Function ExportAccountToOutlook(AccountID As Long) As Boolean
   On Error GoTo ErrHandler
  ' Set up DAO Objects.
   Dim oDataBase As Database
   Dim rst As Recordset
   Set oDataBase = DBEngine(0)(0)
   Set rst = oDataBase.OpenRecordset("SELECT * FROM Accounts" _
   & " WHERE AccountID=" & AccountID, dbOpenSnapshot)

  ' 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 Prop As Outlook.UserProperty

   Set olns = ol.GetNamespace("MAPI")
   Set cf = olns.GetDefaultFolder(olFolderContacts)
   
   If Not rst.EOF Then
       With rst
        ' Create a new Contact item.
           Set c = ol.CreateItem(olContactItem)

        ' Specify which Outlook form to use.
        ' Change "IPM.Contact" to "IPM.Contact.<formname>" if you've
        ' created a custom Contact form in Outlook.
           c.MessageClass = "IPM.Contact"

        ' Create all built-in Outlook fields.
           c.FullName = !FirstName & " " & !LastName
           c.FirstName = ![FirstName]
           c.LastName = ![LastName]
           c.HomeAddressStreet = !StreetAddress
           c.HomeAddressCity = !City
           c.HomeAddressState = !State
           c.HomeAddressPostalCode = !ZIP
           If !TelephoneA <> "" Then c.HomeTelephoneNumber = !TelephoneA
           If !TelephoneB <> "" Then c.BusinessTelephoneNumber = !TelephoneB
           If !Mobile <> "" Then c.MobileTelephoneNumber = !Mobile
           If !Email <> "" Then c.Email1Address = !Email
           c.Categories = "Account"
        ' Create the first user property (UserField1).
           Set Prop = c.UserProperties.Add("AccountID", olText)

        ' Set its value.
           Prop = ![AccountID]

        ' Save the contact.
           c.Save
           ExportAccountToOutlook = True
       End With
   End If

ExitHere:
   On Error Resume Next
   rst.Close
   Set rst = Nothing
   Set c = Nothing
   Set olns = Nothing
   Set cf = Nothing
   Set oDataBase = Nothing
   Exit Function
ErrHandler:
   MsgBox Err.Description & " " & Err.Number
   ExportAccountToOutlook = False
   Resume ExitHere
   
End Function

Enjoy...

That worked perfectly. Thanks, Graham.

grep