Sub ImportContactsFromOutlook()
   ' Set up DAO objects (uses existing "tblContacts" table)
   Dim rst As DAO.Recordset
   Set rst = CurrentDb.OpenRecordset("Contatti")
   ' 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.AddNew
           rst!FirstName = c.FirstName
            rst!LastName = c.LastName
            rst.Update
         End If
      Next i
      rst.Close
      MsgBox "Finished."
   Else
      MsgBox "No contacts to export."
   End If
End Sub