I think you are destined for disappointment. The only information associated with the recipients of an e-mail message is the name and address of each recipient. You can create contacts entries from that information (see below), but the other fields are not available.
Sub CreateContactsFromMail()
Dim olFolder As Outlook.Folder
Dim olNS As Outlook.NameSpace
Dim olItem As ContactItem
Dim sRecip As String
Dim oRecipient As Recipient
Dim oMail As Outlook.MailItem
Set olNS = Application.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(olFolderContacts)
Set oMail = Application.ActiveExplorer.Selection.Item(1)
For Each oRecipient In oMail.Recipients
Set olItem = olFolder.Items.Add(olContactItem)
With olItem
.Email1Address = oRecipient.Address
.Email1DisplayName = oRecipient.Name
.Email1AddressType = oMail.SenderEmailType
.FullName = oRecipient.Name
.Save
End With
DoEvents
Next oRecipient
lbl_Exit:
Set olFolder = Nothing
Set olItem = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set oRecipient = Nothing
Set oMail = Nothing
Exit Sub
End Sub