Extract Outlook Properties of a sender of a mail

Question

I want to extract properties, like phone number, society, email,... from an e-mail which is in my inbox.

Set oOutlookmail = CreateObject("Outlook.Application")
Set oMyInspectors = oOutlookmail.Inspectors
Set oMail = oMyInspectors.Item(lCount2).CurrentItem
gsDate = Left(oMail.ReceivedTime, InStr(1, oMail.ReceivedTime, " ") - 1)

I can have the date but that's all. I looked with Contact item, we can add contact properties but not get the ones of a mail.

An other solution is to add to contacts the sender and delete it after but I didn't find how to do that.

Where are the properties supposed to come from? GAL? Or one of the items in the Contacts folder? — Dmitry Streblechenko, Jul 09 '15 at 14:20
From the email i received. i click on the name of the person, then right clic then outlook properties then there are phone, company... Thanks — hedidev1, Jul 09 '15 at 17:41

score 0 · Answer 1 · answered Jul 10 '15 at 12:34

Phone and other information is not stored in a sender address.

Re: "An other solution is to add to contacts the sender ..."

The limited amount of information available when creating a contact from scratch is described here http://www.slipstick.com/developer/create-contacts-from-messages/.

This macro is compliments of Outlook MVP and developer Ken Slovak from http://www.slovaktech.com

Public Sub AddAddressesToContacts()
Dim folContacts As Outlook.MAPIFolder
Dim colItems As Outlook.Items
Dim oContact As Outlook.ContactItem
Dim oMail As Outlook.MailItem
Dim obj As Object
Dim oNS As Outlook.NameSpace

Dim response As VbMsgBoxResult

Dim bContinue As Boolean

Dim sSenderName As String

On Error Resume Next

Set oNS = Application.GetNamespace("MAPI")
Set folContacts= oNS.GetDefaultFolder(olFolderContacts)
Set colItems= folContacts.Items

For Each obj In Application.ActiveExplorer.Selection
    If obj.Class = olMail Then
        Set oContact= Nothing

        bContinue= True
        sSenderName= ""

        Set oMail = obj

        sSenderName = oMail.SentOnBehalfOfName
        If sSenderName = ";" Then
            sSenderName = oMail.SenderName
        End If

        Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")

        If Not (oContact Is Nothing) Then
            response = MsgBox("This appears to be an existing contact: " & sSenderName & ". Do you still want to add it as a new contact?", vbQuestion + vbYesNo, "Contact Adder")
            If response = vbNo Then
                bContinue = False
            End If
        End If

        If bContinue Then
            Set oContact = colItems.Add(olContactItem)
            With oContact
                .Body = oMail.Subject

                .Email1Address = oMail.SenderEmailAddress
                .Email1DisplayName = sSenderName
                .Email1AddressType = oMail.SenderEmailType

                .FullName = oMail.SenderName

                .Save
            End With
        End If
    End If
Next

Set folContacts = Nothing
Set colItems = Nothing
Set oContact = Nothing
Set oMail = Nothing
Set obj = Nothing
Set oNS = Nothing
End Sub

and here https://msdn.microsoft.com/en-us/library/office/ff869056.aspx

Extract Outlook Properties of a sender of a mail

1 Answers1