The following code sample will generate a .csv file with a list of email addresses of the Senders of the emails in the Inbox folder:
- Copy and paste it into the ThisOutlookSession of the Outlook VBA Editor, and run it;
- The output file will be saved at C:\Test\emails.csv, modify the path in the code as you desired;
- Modify the value of .GetDefaultFolder(olFolderInbox) in the following code line to select the other folder other than Inbox;
Set objFolder = Application.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Sub GetALLEmailAddresses_Resolve_Name()
Dim objFolder As MAPIFolder
Dim strEmail As String
Dim strEmails As String
Dim objDic As Object
Dim objItem As Object
Dim objFSO As Object
Dim objTF As Object
Dim sFromName As String
Set objDic = CreateObject("scripting.dictionary")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objTF = objFSO.createtextfile("C:\Test\emails.csv", 2)
Set objFolder = Application.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
For Each objItem In objFolder.Items
If objItem.Class = olMail Then
sFromName = objItem.SenderName
strEmail = ResolveDisplayNameToSMTP(sFromName)
If strEmail = Empty Then
strEmail = objItem.SenderEmailAddress
If Not objDic.Exists(strEmail) Then
objTF.writeline strEmail
objDic.Add strEmail, ""
End If
Else
If Not objDic.Exists(strEmail) Then
objTF.writeline strEmail
objDic.Add strEmail, ""
End If
End If
End If
Next
objTF.Close
End Sub
Function ResolveDisplayNameToSMTP(sFromName)
Dim oRecip As Outlook.Recipient
Dim oEU As Outlook.ExchangeUser
Dim oEDL As Outlook.ExchangeDistributionList
Set oRecip = Application.Session.CreateRecipient(sFromName)
oRecip.Resolve
If oRecip.Resolved Then
Select Case oRecip.AddressEntry.AddressEntryUserType
Case OlAddressEntryUserType.olExchangeUserAddressEntry
Set oEU = oRecip.AddressEntry.GetExchangeUser
If Not (oEU Is Nothing) Then
Debug.Print oEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
Set oEDL = oRecip.AddressEntry.GetExchangeDistributionList
If Not (oEDL Is Nothing) Then
Debug.Print oEDL.PrimarySmtpAddress
End If
End Select
End If
End Function