Updating Outlook Contacts List With Certificates from Signed Emails

[MajP]

I have a pretty extensive contacts list with custom fields and lots of filled-in and edited data. I have several hundred contacts. We are trying to send more encrypted email and now I want to update as many contacts as I can with their certificate. I cannot figure an easy way to do this manually. I think the coding pseudo code would be (assuming objects are exposed)

Loop messages in inbox
If the message is signed then
  If name is not on the list of downloaded certificates then
    Export certificate to folder
    add name to list
  end if
end if
next message

At that point I could at least import the certificates relatively easily. However if possible think I could do something like this to import.

Loop contact list
  If contact does not have a certificate then
    loop certificate folder 
       If certificate name contains "last name" and "first name" then  (most of my certs are named "last.first.numbers.cer")
         import certificate
         save contact
         exit loop 
       end if
    next certificate
  end if
next contact

Has anyone ever done something like this? If so would be interested in any code or pointers. Thanks.

I can loop and find digitally signed emails, but I do not see anything that exposes a digital id / Certificate object. Manually the method would be to select the sender name. Right click to "add" contact. Go to the certificate and download. I am not seeing these methods exposed either.

Public Sub DownLoadCerts()
   On Error GoTo errLbl
   Dim MyNameSpace As Outlook.NameSpace
   Dim MyFolder As Outlook.MAPIFolder
   Dim Item As Object
   Dim MailItem As Outlook.MailItem
   Dim counter As Integer
   Dim myList As New Collection
   Dim SenderName As String
   Dim MyContact As ContactItem
   
   Set MyNameSpace = GetNamespace("MAPI")
   Set MyFolder = MyNameSpace.GetDefaultFolder(olFolderInbox)
   For Each Item In MyFolder.Items
   If TypeOf Item Is Outlook.MailItem Then
         Set MailItem = Item
         If MailItem.MessageClass = "IPM.Note.SMIME.MultipartSigned" Then
           SenderName = MailItem.SenderEmailAddress
           If Not HasKey(myList, SenderName) Then
             myList.Add SenderName, SenderName 'only want to do it once per digitally signed email
             Debug.Print SenderName & " Sender"
             [COLOR=#EF2929][u]'Need code here to export the certificate from a email that is digitally signed[/u][/color]
             'Debug.Print MyContact.LastNameAndFirstName & " Contact"
           End If
         End If
     End If
     counter = counter + 1
     If counter = 50 Then Exit Sub
    Next Item
    Exit Sub
errLbl:
    Debug.Print Err.Number & " " & Err.Description
    Resume Next
End Sub