提取邮件发件人的 Outlook 属性答案

【问题标题】：Extract Outlook Properties of a sender of a mail提取邮件发件人的 Outlook 属性
【发布时间】：2015-07-09 11:48:07
【问题描述】：

我想从我收件箱中的电子邮件中提取属性，例如电话号码、社会、电子邮件……。

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

我可以知道日期，但仅此而已。我查看了联系人项目，我们可以添加联系人属性但不能获取邮件的属性。

另一种解决方案是将发件人添加到联系人并在之后将其删除，但我没有找到如何做到这一点。

【问题讨论】：

属性应该从哪里来？加尔？还是联系人文件夹中的一项？
来自我收到的电子邮件。我点击这个人的名字，然后右键点击然后Outlook属性然后有电话，公司......谢谢

标签： vba properties outlook contact phone-number

【解决方案1】：

电话和其他信息不存储在发件人地址中。

回复：“另一种解决方案是将发件人添加到联系人中......”

此处http://www.slipstick.com/developer/create-contacts-from-messages/ 描述了从头开始创建联系人时可用的信息量有限。

此宏是来自http://www.slovaktech.com 的 Outlook MVP 和开发人员 Ken Slovak 的赞美

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

这里是https://msdn.microsoft.com/en-us/library/office/ff869056.aspx

【讨论】：