vba代码SenderEmailAddress在Excel中给path

我devise了一个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 

我想看到它作为[e-mail]意味着以正确的电子邮件格式说。 如何利用这个选项？ 我应该在VBA代码或Excel中进行更改。

我曾经在很多博客上尝试过这个方法， 任何build议都会有所帮助。

Answer 1

首先，这是多点表示符号 – Folder.Items.Item(iRow) 。 这是一个非常糟糕的主意，特别是在一个循环中 – 每一个“。” 强制Outlook创build并返回一个全新的COM对象。 在进入循环之前cachingFolder.Items，并且在循环的开始处仅使用Items.Item（I）检索MailItem。

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

Answer 2

在这里看看如何看看全球通讯录Outlook 2010的GAL与Excel VBA

这是一个非常简单的实现，转换为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