Question

我想从收件箱中的电子邮件中提取电话号码，社交，电子邮件等属性。

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

我可以拥有日期，但仅此而已。我查看了联系人项目，我们可以添加联系人属性但不能收到邮件。

另一个解决方案是添加到发件人的联系人并删除它但我没有找到该怎么做。

Answer 1

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

Re：＆＃34;另一种解决方案是向发件人添加联系人......＆＃34;

此处介绍了从头开始创建联系人时可用的有限信息量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

提取邮件发件人的Outlook属性

1 个答案: