Importando arquivos EML no Outlook 2010

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
comments powered by Disqus