new way of checking duplicate entries kinndly help

[indiewolf]

Private Sub oSaveAs_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    
     Dim oSel As Outlook.Selection
    Dim oEmail As Outlook.MailItem
    Dim oContact As Outlook.ContactItem
    Dim pContact As Outlook.ContactItem
Dim Item As Outlook.MailItem
    Set oSel = Application.ActiveExplorer.Selection
   For Each Item In oSel
   If Item.Class = olMail Then
    Set oEmail = Item
   
        Set oContact = Application.CreateItem(olContactItem)
        
        Set pContact = Application.CreateItem(olContactItem)
       
       With oContact
            .Subject = oEmail.Subject
            .Email1Address = oEmail.SenderEmailAddress
            
            .FullName = oEmail.SenderName
            '.Body = oEmail.Body
         
            .Display
        End With
        
        With pContact
        .FullName = oEmail.SenderName
        .Email1Address = oEmail.SenderEmailAddress
     
        .Display
        End With
        
         If ((oContact.Email1Address = pContact.Email1Address)) Then
    
      
     MsgBox "Contact Exists"
           'pContact
      
      Else
  oContact.Save
     MsgBox "Saved"
     Set oContact = Nothing
        Set oEmail = Nothing
        Set oContact = Nothing
    
    Set oSel = Nothing
 
 End If
 
     
      
 End If
 
 
 
 
Next
End Sub

above is the code i have been working upon. the problem is it is not checking whether the contacts are same but the code is running.
very confused kindly help

[westconn1]

what part doesn't work? do you get a message box or does it save the contact each time

put a break point at each if statement to see where it goes

pete