Question

我正在尝试使用Excel-VBA从我发送的邮箱中获取.To电子邮件地址。但是，To仅返回名称而不是电子邮件地址。经过一番搜索后发现recipient应该是我正在寻找的东西。通过遵循msdn指南尝试，但代码似乎不起作用。

Sub test()

Dim objoutlook As Object 
Dim objNamespace As Object 
Dim olFolder As Object
Dim OutlookMail As outlook.MailItem

Set objoutlook = CreateObject("Outlook.Application") 
Set objNamespace = objoutlook.GetNamespace("MAPI") 
Set olFolder = objNamespace.GetDefaultFolder(olFolderSentMail) 
Set OutlookMail = objoutlook.CreateItem(olMailItem)

    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 = OutlookMail.Recipients
    For Each recip In recips    'Something is wrong here
        Set pa = recip.PropertyAccessor
        Debug.Print recip.Name & " SMTP=" & pa.GetProperty(PR_SMTP_ADDRESS)
    Next


Set olFolder = Nothing 
Set objNamespace = Nothing 
Set objoutlook = Nothing

End Sub

我对VBA并不熟悉，请指导。

Answer 1

你可以试试这个：

Private Sub GetRecipientSMTP(objAllRecip As Outlook.Recipients)

    Dim objRecip As Outlook.Recipient
    Dim objExUser As Outlook.ExchangeUser
    Dim objExDisUser As Outlook.ExchangeDistributionList

    For Each objRecip In objAllRecip
        Select Case objRecip.AddressEntry.AddressEntryUserType
        Case 0, 10
            Set objExUser = objRecip.AddressEntry.GetExchangeUser
            If Not objExUser Is Nothing Then _
            Debug.Print objExUser.PrimarySmtpAddress '/* or copy somewhere */

        Case 1
            Set objExDisUser = objRecip.AddressEntry.GetExchangeDistributionList
            If Not objExDisUser Is Nothing Then _
            Debug.Print objExDisUser.PrimarySmtpAddress '/* or copy somewhere */
        Case Else
        '/* Do nothing, recipient not recognized */
        End Select
    Next

End Sub

您可以使用代码中的recips在子网中运行它（或查看示例用法）。

GetRecipientSMTP recips

基本上，这会检查您提供的Recipient上的每个Recipients。
然后会在返回之前检查它是ExchangeUser类型还是ExchangeDistributionList PrimartSMTPAddress。 HTH。

样本使用：

Sub marine()

    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFolder As Outlook.Folder
    Dim olMail As Outlook.MailItem
    Dim i As Integer

    Set olApp = GetObject(, "Outlook.Application") '/* assuming OL is running */
    Set olNs = olApp.GetNamespace("MAPI")
    Set olFolder = olNs.GetDefaultFolder(olFolderInbox)

    With olFolder
        For i = .Items.Count To 1 Step -1
            If TypeOf .Items(i) Is MailItem Then
                Set olMail = .Items(i)
                GetRecipientSMTP olMail.Recipients
            End If
            Exit For '/* I just want to process the first mail */
        Next
    End With

End Sub

_{注意：我使用早期绑定并设置对Outlook对象库的引用。}

Answer 2

快速示例

Option Explicit
Public Sub Example()
    Dim OUTLOOK_APP As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim SENT_FLDR As MAPIFolder
    Dim Items As Outlook.Items
    Dim olRecip As Outlook.Recipient
    Dim olRecipAddress As String
    Dim i As Long

    Set OUTLOOK_APP = New Outlook.Application
    Set olNs = OUTLOOK_APP.GetNamespace("MAPI")

    Set SENT_FLDR = olNs.GetDefaultFolder(olFolderSentMail)
    Set Items = SENT_FLDR.Items

    For i = Items.Count To 1 Step -1
        DoEvents
        If Items(i).Class = olMail Then

            For Each olRecip In Items(i).Recipients
                olRecipAddress = olRecip.Address
                Debug.Print olRecipAddress
            Next

        End If
    Next
End Sub

Answer 3

这是我获取收件人电子邮件地址的方式。我希望它会对你有所帮助。

Sub CopyCurrentContact()

   Dim objRcp As Outlook.Recipient
   Dim objRcpS As Outlook.Recipients
   Dim rcpStr As String
   Set outLookObj = CreateObject("Outlook.Application")
   Set InspectorObj = outLookObj.ActiveInspector
   Set ItemObj = InspectorObj.CurrentItem



  Set objRcpS = ItemObj.Recipients

  For Each objRcp In objRcpS

    rcpStr = objRcp.Address & "; " & rcpStr

    Debug.Print rcpStr
  Next objRcp





End Sub

如何从Excel获取收件人电子邮件地址？

3 个答案: