Harvesting All Email Addresses From an Outlook Mailbox

Let’s face it, I like answering questions. I’m active on both Experts-Exchange and Quora, and have started monitoring Twitter looking for questions I can answer. Earlier this year I discovered Replyz, a novel web service that scans Twitter for questions. Replyz is where I ran across this question from marthasmith.

Does anyone have a magical way to extract all email addresses out of my Outlook? Not just contacts–out of messages, everything.

Harvesting addresses is pretty simple. I showed how to do this for meetings in this earlier post. marthasmith wants to take it a step further and collect address for different Outlook items types (e.g. emails, addresses, contacts, etc.) and she wants to do this for all folders. The first requirement calls for detecting the item type being processed since different types of items have different properties. The second requirement can be satisfied through a recursive loop.

Here is the code for doing this. This solution starts at the currently selected folder and processes it and all folders under it. This gives marthasmith the ability to control where harvesting begins. The code reads all the items in the top level folder, then does the same for every folder under it. Only certain types of items are processed. Notes don’t have addresses associated with them so there’s nothing to do with them. A task could have an address associated with it if the task was assigned, but in my experience that’s a rarely used feature of Outlook tasks. Right now the code ignores tasks. That leaves messages, appointments, contacts, and distribution lists. The code handles all for of those types of items.

In a follow-up tweet marthasmith noted that she wants the addresses put into a database. Without details on what type of database I couldn’t add that to the code. So for the moment the code extracts addresses to a text file.

Here are the instructions marthasmith will follow to add the code to Outlook.

1. Start Outlook
2. Click Tools > Macro > Visual Basic Editor
3. If not already expanded, expand Microsoft Office Outlook Objects
4. If not already expanded, expand Modules
5. Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
7. Edit the code as needed. I included comments wherever something needs to or can change
8. Click the diskette icon on the toolbar to save the changes
9. Close the VB Editor

Dim objFSO As Object, objFile As Object

Sub HarvestAddresses()
    InitDatabase
    ProcessFolder Application.ActiveExplorer.CurrentFolder
    CloseDatabase
    MsgBox "Done"
End Sub

Sub ProcessFolder(olkFld As Outlook.Folder)
    Dim olkItm As Object, olkSubFld As Outlook.Folder, olkRcp As Outlook.Recipient, intIdx As Integer
    For Each olkItm In olkFld.Items
        DoEvents
        Select Case olkItm.Class
            Case olMail, olAppointment
                WriteToDatabase olkItm.SenderEmailAddress
                For Each olkRcp In olkItm.Recipients
                    WriteToDatabase olkRcp.AddressEntry.Address
                Next
            Case olContact
                If olkItm.Email1Address <> "" Then WriteToDatabase olkItm.Email1Address
                If olkItm.Email2Address <> "" Then WriteToDatabase olkItm.Email2Address
                If olkItm.Email3Address <> "" Then WriteToDatabase olkItm.Email3Address
            Case olDistList
                For intIdx = 1 To olkItm.MemberCount
                    WriteToDatabase olkItm.GetMember(intIdx).AddressEntry.Address
                Next
        End Select
    Next
    For Each olkSubFld In olkFld.Folders
        ProcessFolder olkSubFld
        DoEvents
    Next
    Set olkItm = Nothing
    Set olkSubFld = Nothing
    Set olkRcp = Nothing
End Sub

Sub InitDatabase()
    Const ForWriting = 2
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Edit the file name and path on the next line
    Set objFile = objFSO.CreateTextFile("C:\eeTesting\Address Harvest.txt", ForWriting, True)
End Sub

Sub WriteToDatabase(strAddress As String)
    objFile.WriteLine strAddress
End Sub

Sub CloseDatabase()
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
End Sub

When marthasmith is ready to harvest addresses she will

1. Select a starting folder.
2. Run the macro HarvestAddresses

A dialog-box will inform her when the code is finished. She’ll then open the output file where she will find all the addresses.

Notes.

• The code does not currently eliminate duplicates. Addresses are likely to occur multiple times.
• Addresses are not sorted. This could be solved by importing the data into Excel and sorting.