在C＃中将多个eml文件转换为单个PST

Question

I need to write a single function which will take multiple eml files ( may be from a single filesystem folder ) and convert them to a single PST file.

Is it possible? if yes can someone provide a sample code?

I assume its possible because there are many commercial eml to pst converters out there doing this

Answer 1

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 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.

'----------------------------------------------------
' 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:\Outlook Express 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

Answer 2

You can use Redemption for that. Something along the lines:

  set Session = CreateObject("Redemption.RDOSession")
  Session.LogonPstStore("c:\temp\test.pst")
  set Folder = Session.GetDefaultFolder(olFolderInbox)
  set Msg = Folder.Items.Add("IPM.Note")
  Msg.Sent = true
  Msg.Import("c:\temp\test.eml", 1024)
  Msg.Save

Answer 3

Might very well be easier or better ways but one way would probably be to use Interop to automate Outlook. There might be some ability to use the built in Import features of Outlook and that would be the first thing I'd try looking for. Assuming that that's not possible, you should still be able to do it by reading the eml files in your app and then creating the mail items via Interop.

Normally eml files are just text files in MIME format so that's just a matter of reading them in as text files and parsing them. Here 's one article about parsing MIME from C# and otherwise just search for "POP3 C#" and you'll find other articles about that.

Then you use Outlook Interop from the namespace Microsoft.Office.Interop.Outlook as is described here .

At a guess I'd assume that you might have to first create an Application object, then use that to get the Store object (I think each PST file will be one Store ) and then the Folder in there and then find some way to create the MailItem using the data you parsed from the eml file.

This article describes using Outlook automation to create contacts and appointments and could probably be useful.

Answer 4

You can find the specifications to the pst file format here . But I guess you would spend some time putting it all together to create a eml->pst parser yourself. But it should be possible.