VBA代码中的SenderEmailAddress在Excel中给出路径

Question

我设计了一个VBA代码，使用链接从Outlook检索邮件列表从Outlook的收件箱中检索邮件列表

这里有一行代码

ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress

它指定获取发件人的电子邮件地址，但是当它存储在excel中时，它显示如下

/O=EXCHANGELABS/OU=EXCHANGE ADMINISTRATIVE GROUP (FYDIBOHF23SPDLT)/CN=RECIPIENTS/CN=WIPRO365.ONMICROSOFT.COM-52823-C1374FA5

我希望看到它，因为Knowledge@wipro.com的意思是使用正确的电子邮件格式。 如何使用此选项？ 我应该在VBA代码还是excel上进行更改。

我曾在许多博客中尝试过此事，但仍然徒劳。 任何建议都会有所帮助。

Answer 1

首先，这是多点符号的极端Folder.Items.Item(iRow) 。 这是一个非常糟糕的主意，尤其是在循环中-每个“”。 强制Outlook创建并返回全新的COM对象。 在进入循环之前先对Folder.Items进行缓存，并在循环开始时仅使用Items.Item（I）检索MailItem。

就是说，您得到的是一个完全有效的EX类型地址。 首先检查MailItem.SenderEmailType属性。 如果它是“ EX”，请使用MailItem.Sender.GetExchangeUser.PrimarySmtpAddress（准备处理空值）。 否则，只需使用MailItem.SenderEmailAddress属性。

Answer 2

在这里看看如何使用Excel VBA查看全球通讯簿Outlook 2010 GAL

这是一个非常简单的实现，可以转换为Exchange帐户的smtp地址。

Option Explicit
Dim appOL As Object
Dim oGAL As Object
Dim i
Dim oContact
Dim oUser
Dim UserIndex
Dim arrUsers(1 To 65000, 2) As String

Sub test()

End Sub
Sub Download_Outlook_Mail_To_Excel()
'Add Tools->References->"Microsoft Outlook nn.n Object Library"
'nn.n varies as per our Outlook Installation
Dim folders As Outlook.folders
Dim folder As Outlook.MAPIFolder
Dim iRow As Integer
Dim Pst_Folder_Name
Dim MailboxName

Set appOL = CreateObject("Outlook.Application")


'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session)
MailboxName = "your email address"

'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session)
Pst_Folder_Name = "Inbox"

Set folder = Outlook.Session.folders(MailboxName).folders(Pst_Folder_Name)
If folder = "" Then
    MsgBox "Invalid Data in Input"
    GoTo end_lbl1:
End If

'Rad Through each Mail and export the details to Excel for Email Archival
Sheets(1).Activate
Dim mail As Outlook.MailItem
Dim oAccount As Outlook.Account
Dim stringAddress
FillAddress

For iRow = 1 To folder.Items.Count
    If folder.Items.Item(iRow).Class = olMail Then
        Set mail = folder.Items.Item(iRow)
        Sheets(1).Cells(iRow, 1).Select
        Sheets(1).Cells(iRow, 1) = mail.SenderName
        Sheets(1).Cells(iRow, 2) = mail.Subject
        Sheets(1).Cells(iRow, 3) = mail.ReceivedTime
        Sheets(1).Cells(iRow, 4) = mail.Size

        Select Case mail.SenderEmailType
        Case "SMTP"
            Sheets(1).Cells(iRow, 5) = mail.SenderEmailAddress
        Case "EX"
            'Set oAccount = Outlook.
            stringAddress = FindAddress(mail.SenderEmailAddress)
            Sheets(1).Cells(iRow, 5) = stringAddress
        End Select
    End If
    'Set oAccount = mail.SenderEmailAddress
    'Sheets(1).Cells(iRow, 6) = Folder.Items.Item(iRow).Body
Next iRow
MsgBox "Outlook Mails Extracted to Excel"

end_lbl1:

End Sub

Function FindAddress(strAddress)
Dim address As String
For i = 1 To 65000
    If UCase(arrUsers(i, 0)) = strAddress Then
        address = arrUsers(i, 2)
        Exit For
    End If
Next
FindAddress = address
End Function

Sub FillAddress()
    Set oGAL = appOL.GetNamespace("MAPI").AddressLists("Global Address List").AddressEntries
    For i = 1 To oGAL.Count
        Set oContact = oGAL.Item(i)
        If oContact.AddressEntryUserType = 0 Then
            Set oUser = oContact.GetExchangeUser
            If Len(oUser.LastName) > 0 Then
                UserIndex = UserIndex + 1
                arrUsers(UserIndex, 0) = oUser.address
                arrUsers(UserIndex, 1) = oUser.Name
                arrUsers(UserIndex, 2) = oUser.PrimarySmtpAddress
            End If
        End If
    Next i
End Sub