When importing outlook information into my contacts and companies table
Getting error Error 3022; The changes you requested to the table were not
successful because they would create duplicate values in the index, primary
key, or relationship. (Error 3022) You tried to duplicate a value in a field
that is the underlying table's primary key or an index that does not allow
duplicates. The message includes the following instruction: Change the data
in the field or fields that contain duplicate data, remove the index, or
redefine the index to permit duplicate entries, and try again.

How can I verify company name does not exsit in the tblContactCompanies table,
and if it does use that information instead of duplicating it? Any help would
be great! Thanks in advance...

Private Sub cmdImportFromOutlook_Click()
     
  ' Set up DAO objects
  Dim rst As DAO.Recordset
  'Query qryContactWithCompanies uses existing "tblContacts" &
"tblContactCompanies" table
  'SELECT tblContacts.*, tblContactCompanies.CompanyName
  'FROM tblContactCompanies INNER JOIN tblContacts ON tblContactCompanies.
CompanyID = tblContacts.CompanyID;
  'Note CompanyNname field in tblContactCompanies is indexed (No Duplicates)
  Set rst = CurrentDb.OpenRecordset("qryContactWithCompanies")

  ' 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
  Dim iNumContacts As Integer
  Dim I As Variant
 
  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!ContactTypeID = 1
           rst!NameTitle = IIf(Len(C.Title & "") > 0, C.Title, "") '(mr., ms,
mrs....)
           rst!FirstName = IIf(Len(C.FirstName & "") > 0, C.FirstName,
"Unknown")
           rst!CompanyName = IIf(Len(C.CompanyName & "") > 0, C.CompanyName,
Me.LastName & " " & "Family")
            rst.Update
        End If
     Next I
     rst.Close
     Set rst = Nothing
     MsgBox "Finished, Contacts were successfully imported."
     Form.Requery
  Else
       'Something went wrong, couldn't initialize Outlook
       MsgBox "An error occured while importing data."
  End If

End Sub