Extracting all mail addresses from all folders

[ofw62]

Up front: I know how to extract email addresses from 1/one folder using File->Open->Import/Export.
This is limited to 1 folder only, but, AFAIK it does not include any subfolders, hence I should do the same action for each and every folder and each and every account, which is quite a bit of a workload.

Are there any easier ways?

Thanks.

 

[Diane Poremsky]

You'd need to use VBA to export all subfolders at once. I have this macro but haven't yet added a version that walks all of the folders. As written, this macro adds the next export to the same sheet as the first - this could be changed if you wanted 1 sheet per folder. This handles multiline fields properly.
Macro to Export Outlook Fields to Excel

Another options which can be a tad faster than going through the menu (and you can add to one sheet or make new sheets), is setting a list view with all of the fields you want to export then using select all, copy and paste into Excel. This works great on single line fields, does not work as well with body or multiline address fields.
The No-Export way to use Outlook data in Excel

if it's something you do infrequently, time-wise, copy and paste would be the best use of your time - make a custom view with the fields you need and save it then apply to all folders. If you need to do it often, taking the time to perfect a macro can save time in the long run.

 

[ofw62]

Many thanks Diane.
Many of the mails include a list of email addresses (not hidden, not in a BCC field, or something). The email addresses show up in the 'To:' field

Basically it is just a 'one-off' session, so to say.

As for VBA - I am not familiar with that, to be honest. At best I may copy-paste VBA code from Internet for some-Excel-macro, but that is about it.

I just enabled 'Developer' tab in Outlook, clicked on VBA button and Insert - obviously it is all nice and clean.
Am using Office Home & Business 2016 for PC with latest updates.

Copy-pasted the code from:
https://www.slipstick.com/macros/CopyToExcel-selectedfolder.txt

save, file exit VBA and gave it a try.

It looks nice, really.

I am afraid there are one or two drawbacks though.

Probably the easiest one to solve may be the date-time format, which is defaulted to US whereas in Outlook it is EUR style.
Outlook: dd-mm-yyyy
Macro: mm-dd-yyyy

a more complex issue is that the macro pulls out the addresses in the 'To:' field alright, but often the name of a person, not the email address, which is behind it.
In the to-field it may say: Diane Poremsky, but not the actual email address under the contact card, the address with '@' in it, so to say.

Maybe this plainly isn't possible?

Oh, I have not yet tried your other solutions.

 

[ofw62]

Later:
I believe also the default solution, i.e. File->Open->Import/Export, does not offer to export the real email address, instead it also export the 'alias' only, i.e. the name of the person, not the email address.
Regretfully so.

 

[Diane Poremsky]

Later:
I believe also the default solution, i.e. File->Open->Import/Export, does not offer to export the real email address, instead it also export the 'alias' only, i.e. the name of the person, not the email address.
Regretfully so.

Correct - it gets the display name, which may or may not include the email address.

The instructions at How to display the sender's email address in Outlook will show how to add the email address field to the view (for senders) and i have macros that add recipients addresses (as one long string, if there are multiple recipients) - with the fields in the view, copy and paste will work.


In the macro, the date is grabbed with strColF = olItem.ReceivedTime - its not formatted, so changing the Excel format should work. If not, you can change the format in the code -
strColF = format(olItem.ReceivedTime, "dd/mm/yyyy")

Sender address is this field:
strColB = olItem.SenderEmailAddress

Recipient addresses need a bit more code - you need to use the recipient collection to grab them.

Dim Recipients As Outlook.Recipients
Set Recipients = olItem.Recipients
For i = Recipients.count To 1 Step -1
recip$ = Recipients.item(i).Address
recipadd = recip$ & ";" & recipadd
Next i
The put the string recipadd in a cell.

 

[ofw62]

Hi Diane,
Sorry for the confusion, but it involves the receivers email addresses, not the senders.
Specifically I often receive mails with multiple names in the 'To:' field.
I want to extract those.

I am afraid I would not know where to put the above code in the script.
Using Outlook 2016/POP3.

Maybe I need to remove line 54 uptil and incl line 59 (exchange) and put the above instead..?

No idea.

Thanks
=

 

[Diane Poremsky]

you definitely don't need the Exchange stuff- that gets the sender's smtp when both the sender and recipient are on exchange.

use the code in the text file and replace the exchange block with

Dim Recipients As Outlook.Recipients
Dim i As Long
Dim RecipAdd As String
Dim recip 'As Recipient
RecipAdd = ""
Set Recipients = olItem.Recipients
For i = Recipients.Count To 1 Step -1
recip = Recipients.Item(i).Address
Debug.Print recip
RecipAdd = recip & ";" & RecipAdd
Next i

then add
xlSheet.Range("g" & rCount) = RecipAdd
after the other xlsheet ranges.

 

[ofw62]

Thank you.
Now I get a warning, security, I tried various options regarding macro security settings.

=
Option Explicit
Sub CopyToExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim rCount As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath As String

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.MailItem
Dim obj As Object
Dim strColB, strColC, strColD, strColE, strColF As String

' Get Excel set up
enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
strPath = enviro & "\Documents\test.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")
' Process the message record

On Error Resume Next
'Find the next empty line of the worksheet
rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
'needed for Exchange 2016. Remove if causing blank lines.
rCount = rCount + 1

' get the values from outlook
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
For Each obj In Selection

Set olItem = obj

'collect the fields
strColB = olItem.SenderName
strColC = olItem.SenderEmailAddress
strColD = olItem.Body
strColE = olItem.To
strColF = Format(olItem.ReceivedTime, "dd-mm-yyyy")

Dim Recipients As Outlook.Recipients
Dim i As Long
Dim RecipAdd As String
Dim recip 'As Recipient
RecipAdd = ""
Set Recipients = olItem.Recipients
For i = Recipients.Count To 1 Step -1
recip = Recipients.Item(i).Address
Debug.Print recip
RecipAdd = recip & ";" & RecipAdd
Next i

If InStr(1, strColC, "/") > 0 Then
' if exchange, get smtp address
Select Case recip.AddressEntry.AddressEntryUserType
Case OlAddressEntryUserType.olExchangeUserAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olOutlookContactAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
Set oEDL = recip.AddressEntry.GetExchangeDistributionList
If Not (oEDL Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
End Select
End If
' End Exchange section

'write them in the excel sheet
xlSheet.Range("B" & rCount) = strColB
xlSheet.Range("c" & rCount) = strColC
xlSheet.Range("d" & rCount) = strColD
xlSheet.Range("e" & rCount) = strColE
xlSheet.Range("f" & rCount) = strColF
xlSheet.Range("g" & rCount) = RecipAdd

'Next row
rCount = rCount + 1

Next

xlWB.Close 1
If bXStarted Then
xlApp.Quit
End If

Set olItem = Nothing
Set obj = Nothing
Set currentExplorer = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
End Sub

=

 

[Diane Poremsky]

you need to go into outlook's file, options, trust center and enable macros (last option) then restart outlook. After it is fully tested, you can sign it with a digital signature and change the setting to notify.

you don't want to sign it until you are finished testing and editing - otherwise you need to remove the signature and re-sign it after every change.

How to use Outlook's VBA Editor

 

[ofw62]

Oops .., I did set the stuff in trust center but ..
did not restart Outlook.

I am encountering an error though, sorry.

Any suggestions?

=
p.s. if you want me to post the code, let me know.

 

[Diane Poremsky]

That message says the workbook doesn't exist at that path. This macro doesn't create a new workbook, you need to create it before you start.