My wife is changing her job, and asked my help to extract all email addresses from her Outlook so that she could send a goodbye email to all her contacts. Outlook has this feature of exporting some fields to CSV but it has some major problems:

• It does not allow you to export multiple folders, let alone multiple Personal Folders
• It does not preserve unicode characters
• It does not remove duplicates

For solving this problem, I wrote a VBA macro to extract all your contacts from all your mail folders. The Macro is easy to use, and you can customize to your needs.

1. First step is enabling macros in Outlook. On most recent versions the path is something like this:

   

   

   

   

2. Fire up the VBA editor by pressing ALT-F11, and expand the existing Project file (on the left) like this:

3. Paste the following VBA code

   Option Explicit
   Public dict As Variant
   Dim myPath As String, nameEmail As String, strFilename As String
   Dim intLogFile, include As Integer
   Dim pst As Variant, subfolder As Variant, csvFile As Object  
   
   Sub ExtractEmailAddresses()
       Set dict = CreateObject("Scripting.Dictionary")
       'Set CurFolder = Application.ActiveExplorer.CurrentFolder
       Dim myNameSpace As NameSpace
       Set myNameSpace = Application.GetNamespace("MAPI")
   
       Dim fileName As String
       fileName = IIf(Environ$("tmp") <> "", Environ$("tmp"), Environ$("temp")) & "\emails.csv"
   
       If Dir$(fileName) <> "" Then Kill (fileName) '  delete if exists
       Set csvFile = CreateObject("ADODB.Stream")
       csvFile.Type = 2 'Specify stream type - we want To save text/string data.
       csvFile.Charset = "utf-8" 'Specify charset For the source text data.
       csvFile.Open 'Open the stream And write binary data To the object
             
       On Error Resume Next
       For Each pst In myNameSpace.Folders
           include = MsgBox("Include PST " + pst.Name + " (" + pst.Store.FilePath + ") ?", vbYesNo, "Include PST?")
           If (include = vbYes) Then Call Explorefolder(pst, "")
       Next
       csvFile.SaveToFile fileName, 2 'Save binary data To disk
       Shell ("explorer """ & fileName & """")
       Exit Sub
   End Sub
   
   Sub Explorefolder(ByVal folder As folder, ByVal parentPath As String)
       myPath = parentPath & IIf(Len(parentPath) > 0, "\", "") & folder.Name
       Debug.Print "Reading " & myPath
       Call Listemails(folder)
       For Each subfolder In folder.Folders
           Call Explorefolder(subfolder, myPath)
       Next
   End Sub
   
   Sub Listemails(ByVal folder As folder)
       'Dim msg As MailItem
       Dim msg As Object
       Dim rec As Recipient
       Dim Email As String
       Debug.Print "Items: " & folder.Items.Count
       Dim i As Integer
       i = 1
       For Each msg In folder.Items
           If TypeName(msg) = "MailItem" Then
               'Debug.Print "I: " & i
               For Each rec In msg.Recipients
                   'Debug.Print rec.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001E")
                   'Debug.Print rec.name & ": " & rec.Address
                   nameEmail = rec.Name & " <" & rec.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001E") & ">," ' comma separated names and email addresses
                   'nameEmail = rec.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001E") & "," ' comma separated email addresses
                   If (IsNull(nameEmail) Or IsEmpty(nameEmail)) Then nameEmail = rec.Address
                   If (IsNull(nameEmail) Or IsEmpty(nameEmail)) Then nameEmail = rec.Name
                   If Not dict.Exists(nameEmail) Then
                       Call dict.Add(nameEmail, nameEmail)
                       csvFile.WriteText nameEmail & vbCrLf
                   End If
               Next
               i = i + 1
           End If
       Next
   End Sub
   

4. Position the cursor inside the ExtractEmailAddresses block, and press F5 to run.

   • It will loop through all your PST (and Exchange OST) folders and ask one by one which ones should be processed
   • Each processed PST/OST will recursively loop throught all folders and subfolders, reading recipients for every message
     You can customize as you want. E.g. you can only see emails YOU sent, or only emails explicitely sent to you, etc.
   • By default, it’s only extracting email address, but if you want you can use the commented line that instead uses the concatenation of both name and email address. Please note that you will probably end up with some duplicated address (same email address and different variations of how the name was written).
   • All distinct values are written to a file “emails.csv” inside your %TEMP% folder.
   • After finishing, this CSV file is opened using default associated program. If doesn’t work you can try replacing CSV by TXT.
   • All addresses are already separated by commas, so that you can just copy and paste into your goodbye email.

5. Celebrate with your work friends, and enjoy your new job!! :-)

Note: Original code was using “Open file For Append”, but it was incorrectly saving non-ANSI characters, so I changed code to write using UTF-8