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

Há algumas formas documentadas de exportar emails do Outlook Express para o Outlook 2010. Um dos principais problemas desta migração, é que você precisa ter tanto o Outlook Express quanto o Outlook 2010 instalados na mesma máquina. Se você instalou o Outlook 2010 em uma máquina que não tinha anteriormente o Outlook Express, pode ser até impossível fazer esta migração, já que o Outlook Express não pode ser instalado em um Sistema Operacional de 64 bits.

Se você não tem ambos instalados na mesma máquina, a solução proposta costuma ser primeiramente importar as suas caixas EBX do Outlook Express para Windows Live Mail, e depois exportá-las do Windows Live Mail para o Outlook 2010.

Tendo passado por este procedimento, posso afirmar que é um procedimento bem complicado e chato. Primeiramente, notei que vários emails do Outlook Express não estavam sendo importados para o Windows Live Mail. Depois, notei que mesmo alguns emails que apareciam no Windows Live Mail não podiam ser exportados para o Outlook 2010, falhando com um MAPI error, e pelo que pesquisei não há correção disponível para sistemas 64-bit.

Para solucionar o problema, descobri a ferramenta Portable Outlook Express Message Extractor, um freeware que permite exportar as mensagens do Outlook Express em formato EML. Pelos meus testes, todos emails foram exportados, o que se provou melhor do que a importação do Windows Live Mail.

Após ter exportado todos arquivos EML, todos eles já vindo agrupados em estrutura de pastas idêntica aos folders do Outlook Express, eu ainda precisava de algo para importar estes emails para o Outlook 2010.

Encontrei alguns programas shareware que supostamente deveriam importar arquivos EML no Outlook, mas fiquei surpreso que o próprio Outlook não tem isso como funcionalidade nativa.

Ao invés de comprar o shareware, decidi criar minha própria macro VBA para isso, já que tenho muita experiência com VBA. Pra minha surpresa, descobri que apesar do Outlook conseguir abrir arquivos EML, não há uma forma programática de fazer isso puramente com VBA. Deste modo, fiz uma pequena macro VBA que percorre os arquivos EML de uma pasta, e abre cada um deles usando SHELL EXEC. Pode levar alguns milisegundos até o Outlook abrir o item, então o VBA aguarda até que algo esteja aberto no ActiveInspector. Por fim, este email é copiado para uma pasta escolhida, e em caso de sucesso o EML original é excluído.

A macro costuma travar algumas vezes, mas normalmente você pode reiniciá-la a qualquer momento e ela recomeça de onde parou (lembre-se que os EMLs importados são excluídos). Se a macro continuar travando constantemente, provavelmente o próximo EML possui algum problema. Neste caso você pode apagá-lo manualmente.

PS: Algumas vezes você pode abrir o EML manualmente e o Outlook vai abrir sem travar, mas pelos meus testes, todos os EMLs que travaram a macro eram arquivos sem importância, como recibos de leitura.

Segue abaixo o código VBA. Se você tiver qualquer dúvida ou problema, entre em contato (PS: tenho disponibilidade para freelance).

'----------------------------------------------------
' Code by Ricardo Drizin (contact info at http://www.drizin.com.br)
'----------------------------------------------------
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Option Explicit
 
'---------------------------------------------------------------------
' This method closes ActiveInspectors if any.
' All inporting is based on the assumption that the EML
' is opened by shell and we can refer to it through the ActiveInspector
'---------------------------------------------------------------------
Function CloseOpenInspectors() As Boolean
    Dim app As Outlook.Application: Set app = CreateObject("Outlook.Application")
    Dim insp As Outlook.Inspector
    Dim count As Integer
    count = 0
repeat:
    count = count + 1
    Set insp = app.ActiveInspector
    If TypeName(insp) = "Nothing" Then
        CloseOpenInspectors = True
        Exit Function
    End If
    If TypeName(insp.CurrentItem) = "Nothing" Then
        CloseOpenInspectors = True
        Exit Function
    End If
    If (count > 100) Then
        MsgBox "Error. Could not close ActiveInspector. "
        CloseOpenInspectors = False
    End If
     
    insp.Close (olDiscard)
    GoTo repeat
End Function
 
 
'---------------------------------------------------------------------
' This method allows user to choose a Root Folder in Outlook
' All EML files will be imported under this folder
'---------------------------------------------------------------------
Function GetRootFolder() As Outlook.folder
    Dim app As Outlook.Application: Set app = CreateObject("Outlook.Application")
    Dim NS As Outlook.NameSpace: Set NS = app.GetNamespace("MAPI")
    Dim fold As Outlook.folder
    Set fold = NS.PickFolder
    'MsgBox fold.Name
    Set GetRootFolder = fold
End Function
 
'---------------------------------------------------------------------
' Creates a child folder in Outlook, under root folder.
'---------------------------------------------------------------------
Function GetChildFolder(parentFolder As Outlook.folder, name As String)
    On Error Resume Next
    Dim fold2 As Outlook.folder
    Set fold2 = parentFolder.folders.Item(name)
    If Err.Number Then
        On Error GoTo 0
        Set fold2 = parentFolder.folders.Add(name)
    End If
    On Error GoTo 0
    'MsgBox fold2.Name
    Set GetChildFolder = fold2
End Function
     
'---------------------------------------------------------------------
' Imports the EML open in the current ActiveInspector
' into the given folder
'---------------------------------------------------------------------
Sub ImportOpenItem(targetFolder As Outlook.folder)
    Dim app As Outlook.Application: Set app = CreateObject("Outlook.Application")
    Dim insp As Outlook.Inspector: Set insp = app.ActiveInspector
     
    Dim retries As Integer
    retries = 0
    While TypeName(insp) = "Nothing" ' READING PANE should be visible, or else it will not work.
        'MsgWaitObj (1000)
        Sleep (50)
        DoEvents
        Sleep (50)
        Set insp = app.ActiveInspector
        retries = retries + 1
        'If retries > 100 Then
        '    Stop
        'End If
    Wend
     
    If TypeName(insp) = "Nothing" Then
        MsgBox "Error! Could not find open inspector for importing email."
        Exit Sub
    End If
     
     
    Dim m As MailItem, m2 As MailItem, m3 As MailItem
    Set m = insp.CurrentItem
    'MsgBox m.Subject
    Set m2 = m.Copy
    Set m3 = m2.Move(targetFolder)
    m3.Save
    Set m = Nothing
    Set m2 = Nothing
    Set m3 = Nothing
    insp.Close (olDiscard)
    Set insp = Nothing
End Sub
 
 
'---------------------------------------------------------------------
' Scans a given folder for *.EML files and import them
' into the given folder.
' Each EML file will be deleted after importing.
'---------------------------------------------------------------------
Sub ImportEMLFromFolder(targetFolder As Outlook.folder, emlFolder As String)
    If Right(emlFolder, 1) <> "\" Then emlFolder = emlFolder & "\"
    Dim firstImport As Boolean: firstImport = True
    
    Dim file As String
    Dim count As Integer: count = 0
    'MsgBox fold.Items.count
    'Exit Sub
    file = Dir(emlFolder & "*.eml")
     
repeat:
    If file = "" Then
        'MsgBox "Finished importing EML files. Total = " & count
        Debug.Print "Finished importing EML files. Total = " & count
        Exit Sub
    End If
    count = count + 1
     
    Debug.Print "Importing... " & file & " - " & emlFolder
    Shell ("explorer """ & emlFolder & file & """")
    'If firstImport Then Stop
    firstImport = False
    Sleep (50)
    On Error GoTo nextfile
    Call ImportOpenItem(targetFolder)
    Call Kill(emlFolder & file)
nextfile:
    On Error GoTo 0
    Sleep (50)
     
    file = Dir()
    GoTo repeat
End Sub
 
'---------------------------------------------------------------------
' Main method.
' User chooses an Outlook root Folder, and a Windows Explorer root folder.
' All EML files inside this folder and in immediate subfolders will be imported.
'---------------------------------------------------------------------
Sub ImportAllEMLSubfolders()
    Call CloseOpenInspectors
     
    MsgBox "Choose a root folder for importing "
    Dim rootOutlookFolder As Outlook.folder
    Set rootOutlookFolder = GetRootFolder()
    If rootOutlookFolder Is Nothing Then Exit Sub
     
    Dim rootWindowsFolder As String
    rootWindowsFolder = "D:\OutlookExpress-EMLs-folder"
    rootWindowsFolder = InputBox("Choose a windows folder where you have your EML files", , rootWindowsFolder)
    If IsNull(rootWindowsFolder) Or IsEmpty(rootWindowsFolder) Or rootWindowsFolder = "" Then Exit Sub
    If Right(rootWindowsFolder, 1) <> "\" Then rootWindowsFolder = rootWindowsFolder & "\"
     
    Dim subFolders As New Collection
     
    Dim subFolder As String
    subFolder = Dir(rootWindowsFolder, vbDirectory)
repeat:
    If subFolder = "." Or subFolder = ".." Then GoTo nextdir
    If (GetAttr(rootWindowsFolder & subFolder) And vbDirectory) = 0 Then GoTo nextdir
    subFolders.Add (subFolder)
nextdir:
    subFolder = Dir()
    If subFolder <> "" Then GoTo repeat
 
Dim outlookFolder As Outlook.folder
 
' Importing main folder
Call ImportEMLFromFolder(rootOutlookFolder, rootWindowsFolder)
 
' Importing subfolders
While subFolders.count
    subFolder = subFolders.Item(1)
    subFolders.Remove (1)
    Set outlookFolder = GetChildFolder(rootOutlookFolder, subFolder)
    Debug.Print "Importing " & rootWindowsFolder & subFolder & " into Outlook folder " & outlookFolder.name & "..."
    Call ImportEMLFromFolder(outlookFolder, rootWindowsFolder & subFolder)
Wend
    Debug.Print "Finished"
     
End Sub

There are some documented ways of exporting Outlook Express emails to Outlook 2010. One major problem with this migration, is that you need to have both Outlook Express and Outlook 2010 installed on the same machine. If you have installed Outlook 2010 on a fresh Windows installation it could even be impossible to do, since Outlook Express cannot be installed on x64 Operating Systems.

If you don’t have both on the same machine, the alternative proposed solution is to import your EBX mailboxes from Outlook Express to Windows Live Mail first, and then exporting from Windows Live Mail to Outlook 2010.

Having been through that, I can tell you that this method is a pain in the ass. First of all, I noticed that many emails from Outlook Express were not being copied to Windows Live Mail. Next, I realized that even the emails which were appearing in Windows Live Mail could not be exported to Outlook 2010, failing with a MAPI error, and as far as I researched there is no fix available for 64-bit systems.

Having said that, I found this Portable Outlook Express Message Extractor, a nice freeware utility which could export EML files from Outlook Express. According to my tests, all emails have been exported, which proved to be better than Windows Live Mail importing.

After having exported EML files, all of them grouped in windows folders which mimic the same folder names of Outlook Express, I needed to found something to import those emails to Outlook.

I found some shareware programs that are supposed to import EML files into Outlook 2010, but I was very surprised that Outlook doesn’t have this as native feature.

Instead of buying the shareware, I decided to create my own VBA macro for that, since I have large VBA programming background. To my surprise, although Outlook can open EML files, there is no way to do it programatically only with VBA. So I created this VBA macro which loops through some folder, and opens each EML file by using SHELL EXEC. It may take a few milliseconds until Outlook opens the EML file, so the VBA waits until something is open in ActiveInspector. Finally, this email is copied into some chosen folder, and (in case of success) the original EML file is deleted.

This macro crashes sometimes, but you can restart the macro at any time, and it will restart from where it previously crashed (remember, all successfully imported EML files are deleted). If it keeps crashing after restart, then probably there is a problem with the next EML file which is about to be imported. In this case you can just delete the problematic EML.

PS: Sometimes you can open the EML yourself, without crashing Outlook, but according to my tests, everytime that a EML file was crashing Outlook it was something unimportant, like read receipts.

Here follows my VBA code. If you have any doubts or problems, let me know (and I’m available for VBA freelance).

'----------------------------------------------------
' Code by Ricardo Drizin (contact info at http://www.drizin.com.br)
'----------------------------------------------------
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Option Explicit
 
'---------------------------------------------------------------------
' This method closes ActiveInspectors if any.
' All inporting is based on the assumption that the EML
' is opened by shell and we can refer to it through the ActiveInspector
'---------------------------------------------------------------------
Function CloseOpenInspectors() As Boolean
    Dim app As Outlook.Application: Set app = CreateObject("Outlook.Application")
    Dim insp As Outlook.Inspector
    Dim count As Integer
    count = 0
repeat:
    count = count + 1
    Set insp = app.ActiveInspector
    If TypeName(insp) = "Nothing" Then
        CloseOpenInspectors = True
        Exit Function
    End If
    If TypeName(insp.CurrentItem) = "Nothing" Then
        CloseOpenInspectors = True
        Exit Function
    End If
    If (count > 100) Then
        MsgBox "Error. Could not close ActiveInspector. "
        CloseOpenInspectors = False
    End If
     
    insp.Close (olDiscard)
    GoTo repeat
End Function
 
 
'---------------------------------------------------------------------
' This method allows user to choose a Root Folder in Outlook
' All EML files will be imported under this folder
'---------------------------------------------------------------------
Function GetRootFolder() As Outlook.folder
    Dim app As Outlook.Application: Set app = CreateObject("Outlook.Application")
    Dim NS As Outlook.NameSpace: Set NS = app.GetNamespace("MAPI")
    Dim fold As Outlook.folder
    Set fold = NS.PickFolder
    'MsgBox fold.Name
    Set GetRootFolder = fold
End Function
 
'---------------------------------------------------------------------
' Creates a child folder in Outlook, under root folder.
'---------------------------------------------------------------------
Function GetChildFolder(parentFolder As Outlook.folder, name As String)
    On Error Resume Next
    Dim fold2 As Outlook.folder
    Set fold2 = parentFolder.folders.Item(name)
    If Err.Number Then
        On Error GoTo 0
        Set fold2 = parentFolder.folders.Add(name)
    End If
    On Error GoTo 0
    'MsgBox fold2.Name
    Set GetChildFolder = fold2
End Function
     
'---------------------------------------------------------------------
' Imports the EML open in the current ActiveInspector
' into the given folder
'---------------------------------------------------------------------
Sub ImportOpenItem(targetFolder As Outlook.folder)
    Dim app As Outlook.Application: Set app = CreateObject("Outlook.Application")
    Dim insp As Outlook.Inspector: Set insp = app.ActiveInspector
     
    Dim retries As Integer
    retries = 0
    While TypeName(insp) = "Nothing" ' READING PANE should be visible, or else it will not work.
        'MsgWaitObj (1000)
        Sleep (50)
        DoEvents
        Sleep (50)
        Set insp = app.ActiveInspector
        retries = retries + 1
        'If retries > 100 Then
        '    Stop
        'End If
    Wend
     
    If TypeName(insp) = "Nothing" Then
        MsgBox "Error! Could not find open inspector for importing email."
        Exit Sub
    End If
     
     
    Dim m As MailItem, m2 As MailItem, m3 As MailItem
    Set m = insp.CurrentItem
    'MsgBox m.Subject
    Set m2 = m.Copy
    Set m3 = m2.Move(targetFolder)
    m3.Save
    Set m = Nothing
    Set m2 = Nothing
    Set m3 = Nothing
    insp.Close (olDiscard)
    Set insp = Nothing
End Sub
 
 
'---------------------------------------------------------------------
' Scans a given folder for *.EML files and import them
' into the given folder.
' Each EML file will be deleted after importing.
'---------------------------------------------------------------------
Sub ImportEMLFromFolder(targetFolder As Outlook.folder, emlFolder As String)
    If Right(emlFolder, 1) <> "\" Then emlFolder = emlFolder & "\"
    Dim firstImport As Boolean: firstImport = True
    
    Dim file As String
    Dim count As Integer: count = 0
    'MsgBox fold.Items.count
    'Exit Sub
    file = Dir(emlFolder & "*.eml")
     
repeat:
    If file = "" Then
        'MsgBox "Finished importing EML files. Total = " & count
        Debug.Print "Finished importing EML files. Total = " & count
        Exit Sub
    End If
    count = count + 1
     
    Debug.Print "Importing... " & file & " - " & emlFolder
    Shell ("explorer """ & emlFolder & file & """")
    'If firstImport Then Stop
    firstImport = False
    Sleep (50)
    On Error GoTo nextfile
    Call ImportOpenItem(targetFolder)
    Call Kill(emlFolder & file)
nextfile:
    On Error GoTo 0
    Sleep (50)
     
    file = Dir()
    GoTo repeat
End Sub
 
'---------------------------------------------------------------------
' Main method.
' User chooses an Outlook root Folder, and a Windows Explorer root folder.
' All EML files inside this folder and in immediate subfolders will be imported.
'---------------------------------------------------------------------
Sub ImportAllEMLSubfolders()
    Call CloseOpenInspectors
     
    MsgBox "Choose a root folder for importing "
    Dim rootOutlookFolder As Outlook.folder
    Set rootOutlookFolder = GetRootFolder()
    If rootOutlookFolder Is Nothing Then Exit Sub
     
    Dim rootWindowsFolder As String
    rootWindowsFolder = "D:\OutlookExpress-EMLs-folder"
    rootWindowsFolder = InputBox("Choose a windows folder where you have your EML files", , rootWindowsFolder)
    If IsNull(rootWindowsFolder) Or IsEmpty(rootWindowsFolder) Or rootWindowsFolder = "" Then Exit Sub
    If Right(rootWindowsFolder, 1) <> "\" Then rootWindowsFolder = rootWindowsFolder & "\"
     
    Dim subFolders As New Collection
     
    Dim subFolder As String
    subFolder = Dir(rootWindowsFolder, vbDirectory)
repeat:
    If subFolder = "." Or subFolder = ".." Then GoTo nextdir
    If (GetAttr(rootWindowsFolder & subFolder) And vbDirectory) = 0 Then GoTo nextdir
    subFolders.Add (subFolder)
nextdir:
    subFolder = Dir()
    If subFolder <> "" Then GoTo repeat
 
Dim outlookFolder As Outlook.folder
 
' Importing main folder
Call ImportEMLFromFolder(rootOutlookFolder, rootWindowsFolder)
 
' Importing subfolders
While subFolders.count
    subFolder = subFolders.Item(1)
    subFolders.Remove (1)
    Set outlookFolder = GetChildFolder(rootOutlookFolder, subFolder)
    Debug.Print "Importing " & rootWindowsFolder & subFolder & " into Outlook folder " & outlookFolder.name & "..."
    Call ImportEMLFromFolder(outlookFolder, rootWindowsFolder & subFolder)
Wend
    Debug.Print "Finished"
     
End Sub