Gandalf's notebook: Harvesting All Email Addresses From an Outlook Mailbox

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.

Start Outlook

Click Tools > Macro > Visual Basic Editor

If not already expanded, expand Microsoft Office Outlook Objects

If not already expanded, expand Modules

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.

Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window

Edit the code as needed. I included comments wherever something needs to or can change

Click the diskette icon on the toolbar to save the changes

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()

   Set objFSO = CreateObject("Scripting.FileSystemObject")

   'Edit the file name and path on the next line

   Set objFile = objFSO.OpenTextFile("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