[英]SenderEmailAddress in vba code giving path in excel
I have designed a VBA code to retrieve the list of mails from the inbox of your outlook using the link Retrieve maillist from outlook 我设计了一个VBA代码,使用链接从Outlook检索邮件列表从Outlook的收件箱中检索邮件列表
Here there is a line of code 这里有一行代码
ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress
which specifies to get senders email Address but when it is stored in excel it shows as below 它指定获取发件人的电子邮件地址,但是当它存储在excel中时,它显示如下
/O=EXCHANGELABS/OU=EXCHANGE ADMINISTRATIVE GROUP (FYDIBOHF23SPDLT)/CN=RECIPIENTS/CN=WIPRO365.ONMICROSOFT.COM-52823-C1374FA5
I would like to see it as knowledge@wipro.com mean to say in the proper email format. 我希望看到它,因为Knowledge@wipro.com的意思是使用正确的电子邮件格式。 How to avail this option?
如何使用此选项? Should I do changes at VBA code or excel.
我应该在VBA代码还是excel上进行更改。
I have tried this in many blogs still vain. 我曾在许多博客中尝试过此事,但仍然徒劳。 Any suggestions will be helpful.
任何建议都会有所帮助。
Firstly, this is multiple dot notation take to its extreme - Folder.Items.Item(iRow)
. 首先,这是多点符号的极端
Folder.Items.Item(iRow)
。 This is a really bad idea, especially in a loop - each "." 这是一个非常糟糕的主意,尤其是在循环中-每个“”。 forces Outlook to create and return a brand new COM object.
强制Outlook创建并返回全新的COM对象。 Cache Folder.Items before entering the loop, and retrieve MailItem using Items.Item(I) only once at the beginning of the loop.
在进入循环之前先对Folder.Items进行缓存,并在循环开始时仅使用Items.Item(I)检索MailItem。
That being said, what you get is a perfectly valid EX type address. 就是说,您得到的是一个完全有效的EX类型地址。 Check the
MailItem.SenderEmailType
property first. 首先检查
MailItem.SenderEmailType
属性。 If it is "EX", use MailItem.Sender.GetExchangeUser.PrimarySmtpAddress (be prepared to handle nulls). 如果它是“ EX”,请使用MailItem.Sender.GetExchangeUser.PrimarySmtpAddress(准备处理空值)。 Otherwise just use
MailItem.SenderEmailAddress
property. 否则,只需使用
MailItem.SenderEmailAddress
属性。
Have a look here for how to look at the Global Address Book Outlook 2010 GAL with Excel VBA 在这里看看如何使用Excel VBA查看全球通讯簿Outlook 2010 GAL
Here is a very simple implementation that converts to the smtp address for Exchange accounts. 这是一个非常简单的实现,可以转换为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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.