vba 如何从 Outlook 的“收件人”字段中提取电子邮件地址？

How do you extract email addresses from the 'To' field in outlook?

提问by surfer190

I have been using VBA to some degree, using this code:

我在某种程度上一直在使用 VBA，使用以下代码：

Sub ExtractEmail()
Dim OlApp As Outlook.Application
Dim Mailobject As Object
Dim Email As String
Dim NS As NameSpace
Dim Folder As MAPIFolder
Set OlApp = CreateObject("Outlook.Application")
' Setup Namespace
Set NS = ThisOutlookSession.Session
' Display select folder dialog
Set Folder = NS.PickFolder
' Create Text File
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\mydocuments\emailss.txt", True)
' loop to read email address from mail items.
For Each Mailobject In Folder.Items
   Email = Mailobject.To
   a.WriteLine (Email)
Next
Set OlApp = Nothing
Set Mailobject = Nothing
a.Close
End Sub

However this gives output as the names of the email addresses and not the actual email address with the "[email protected]".

但是，这将输出作为电子邮件地址的名称，而不是带有"[email protected]".

Is there an attributte of the mailobject that will allow the email addresses and not the names to be written from the 'To'Textbox.

是否有允许从'To'文本框中写入电子邮件地址而不是名称的邮件对象的属性。

Thanks

谢谢

回答by Jake Bathman

Check out the Recipients collection object for your mail item, which should allow you to get the address: http://msdn.microsoft.com/en-us/library/office/ff868695.aspx

查看您的邮件项目的收件人集合对象，它应该允许您获取地址：http: //msdn.microsoft.com/en-us/library/office/ff868695.aspx

---

---

Update 8/10/2017

2017 年 8 月 10 日更新

Looking back on this answer, I realized I did a bad thing by only linking somewhere and not providing a bit more info.

回顾这个答案，我意识到我只是在某处链接而不提供更多信息，这是一件坏事。

Here's a code snippet from that MSDN link above, showing how the Recipients object can be used to get an email address (snippet is in VBA):

这是来自上面 MSDN 链接的代码片段，展示了如何使用 Recipients 对象获取电子邮件地址（片段在 VBA 中）：

Sub GetSMTPAddressForRecipients(mail As Outlook.MailItem) 
    Dim recips As Outlook.Recipients 
    Dim recip As Outlook.Recipient 
    Dim pa As Outlook.PropertyAccessor 
    Const PR_SMTP_ADDRESS As String = _ 
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E" 
    Set recips = mail.Recipients 
    For Each recip In recips 
        Set pa = recip.PropertyAccessor 
        Debug.Print recip.name &; " SMTP=" _ 
           &; pa.GetProperty(PR_SMTP_ADDRESS) 
    Next 
End Sub 

回答by Steven

It looks like, for email addresses outside of your organization, the SMTP address is hidden in emailObject.Recipients(i).Address, though it doesn't seem to allow you to distinguish To/CC/BCC.

看起来，对于组织外部的电子邮件地址，SMTP 地址隐藏在 中emailObject.Recipients(i).Address，但它似乎不允许您区分 To/CC/BCC。

The Microsoft code was giving me an error, and some investigating reveals that the schema page is no longer available. I wanted a semicolon-delaminated list of email addresses that were either in my Exchange organization or outside of it. Combining it with another S/O answer to convert inner-company email display names to SMTP names, this does the trick.

Microsoft 代码给了我一个错误，一些调查显示架构页面不再可用。我想要一个以分号分隔的电子邮件地址列表，这些电子邮件地址要么在我的 Exchange 组织内，要么在它的外部。将它与另一个 S/O 答案结合起来，将公司内部电子邮件显示名称转换为 SMTP 名称，这就是诀窍。

Function getRecepientEmailAddress(eml As Variant)
    Set out = CreateObject("System.Collections.Arraylist") ' a JavaScript-y array

    For Each emlAddr In eml.Recipients
        If Left(emlAddr.Address, 1) = "/" Then
            ' it's an Exchange email address... resolve it to an SMTP email address
            out.Add ResolveDisplayNameToSMTP(emlAddr)
        Else
            out.Add emlAddr.Address
        End If
    Next
    getRecepientEmailAddres = Join(out.ToArray(), ";")
End Function

If the email is inside your organization, you need to convert it to an SMTP email address. I found this function from another StackOverflow answerhelpful:

如果电子邮件在您的组织内部，则需要将其转换为 SMTP 电子邮件地址。我发现另一个 StackOverflow 答案中的这个函数很有帮助：

Function ResolveDisplayNameToSMTP(sFromName) As String
    ' takes a Display Name (i.e. "James Smith") and turns it into an email address ([email protected])
    ' necessary because the Outlook address is a long, convoluted string when the email is going to someone in the organization. 
    ' source:  https://stackoverflow.com/questions/31161726/creating-a-check-names-button-in-excel

    Dim OLApp As Object 'Outlook.Application
    Dim oRecip As Object 'Outlook.Recipient
    Dim oEU As Object 'Outlook.ExchangeUser
    Dim oEDL As Object 'Outlook.ExchangeDistributionList

    Set OLApp = CreateObject("Outlook.Application")
    Set oRecip = OLApp.Session.CreateRecipient(sFromName)
    oRecip.Resolve
    If oRecip.Resolved Then
        Select Case oRecip.AddressEntry.AddressEntryUserType
            Case 0, 5 'olExchangeUserAddressEntry & olExchangeRemoteUserAddressEntry
                Set oEU = oRecip.AddressEntry.GetExchangeUser
                If Not (oEU Is Nothing) Then
                    ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress
                End If
            Case 10, 30 'olOutlookContactAddressEntry & 'olSmtpAddressEntry
                    ResolveDisplayNameToSMTP = oRecip.AddressEntry.Address
        End Select
    End If
End Function