在C＃中將多個eml文件轉換為單個PST

Question

我需要編寫一個函數，該函數將接收多個eml文件（可能來自單個文件系統文件夾）並將它們轉換為單個PST文件。

可能嗎？ 如果是，有人可以提供示例代碼嗎？

我認為這是有可能的，因為有很多商業的EML到PST轉換器正在這樣做

Answer 1

盡管Outlook可以打開EML文件 ，但是無法僅通過VBA 以編程方式進行操作 。 因此，我創建了一個VBA宏，該宏循環通過某些文件夾並使用SHELL EXEC打開每個EML文件。 直到Outlook打開EML文件為止，可能要花費幾毫秒的時間，因此VBA會等到在ActiveInspector中打開某些內容。 最后，將這封電子郵件復制到某個選定的文件夾中，並在成功的情況下刪除原始的EML文件。

該宏有時會崩潰，但是您可以隨時重新啟動該宏，它將從先前崩潰的位置重新啟動（請記住，所有成功導入的EML文件都將被刪除 ）。 如果重新啟動后仍然崩潰，則可能是下一個將要導入的EML文件存在問題。 在這種情況下，您可以刪除有問題的EML。

PS：有時您可以自己打開EML而不會使Outlook崩潰，但根據我的測試，每次EML文件使Outlook崩潰時，它都是不重要的，例如已讀回執。

這是我的VBA代碼 。 如果您有任何疑問或問題，請告訴我。

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

您可以為此使用贖回 。 大致情況：

  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

可能是更好或更簡單的方法，但是一種方法可能是使用Interop自動執行Outlook。 可能有些功能可以使用Outlook的內置導入功能，而這將是我嘗試尋找的第一件事。 假設這不可能，那么您仍然可以通過讀取應用程序中的eml文件，然后通過Interop創建郵件項目來做到這一點。

通常，eml文件只是MIME格式的文本文件，因此只需將它們讀取為文本文件並進行解析即可。 這是一篇有關從C＃解析MIME的文章，否則只需搜索“ POP3 C＃”，您還將找到有關此內容的其他文章。

然后你從命名空間中使用Outlook互操作Microsoft.Office.Interop.Outlook中被描述為在這里 。

猜想我會假設您可能必須先創建一個Application對象，然后使用它來獲取Store對象（我認為每個PST文件將是一個Store ），然后在其中找到Folder ，然后找到某種創建方法使用您從eml文件中解析的數據來處理MailItem 。

該文章描述了使用Outlook自動化創建聯系人和約會，並很可能是有用的。

Answer 4

您可以在此處找到pst文件格式的規范。 但是我想您會花一些時間將它們放在一起以自己創建eml-> pst解析器。 但這應該是可能的。