在C＃中将多个eml文件转换为单个PST
我需要编写一个函数，它将获取多个eml文件（可能来自单个文件系统文件夹）并将它们转换为单个PST文件。
可能吗？ 如果是，有人可以提供示例代码吗？
我认为它可能是因为有很多商业eml到pst转换器那里做这个
虽然Outlook可以打开EML文件 ，但是无法仅使用VBA 以编程方式执行此操作 。 所以我创建了这个VBA宏，它循环遍历某个文件夹并使用SHELL EXEC打开每个EML文件。 在Outlook打开EML文件之前可能需要几毫秒，因此VBA会等待，直到ActiveInspector中的某些内容打开。 最后，将此电子邮件复制到某个选定的文件夹中，并且（如果成功）将删除原始EML文件。
此宏有时会崩溃，但您可以随时重新启动宏，它将从之前崩溃的位置重新启动（请记住，所有成功导入的EML文件都将被删除 ）。 如果它在重新启动后继续崩溃，则可能是下一个即将导入的EML文件存在问题。 在这种情况下，您可以删除有问题的EML。
PS：有时你可以自己打开EML，而不会崩溃Outlook，但根据我的测试，每次EML文件崩溃时，它都是不重要的，比如阅读收据。
这是我的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 可能很容易或更好的方式，但一种方法可能是使用Interop自动化Outlook。 可能有一些能力使用Outlook的内置导入function，这将是我尝试寻找的第一件事。 假设这是不可能的，您仍然可以通过阅读应用程序中的eml文件然后通过Interop创建邮件项目来实现。
通常，eml文件只是MIME格式的文本文件，因此只需将它们作为文本文件读取并解析它们即可。 这是一篇关于从C＃解析MIME的文章，否则只是搜索“POP3 C＃”，你会发现其他文章。
然后使用命名空间Microsoft.Office.Interop.Outlook Outlook Interop，如此处所述。
我猜你可能不得不首先创建一个Application对象，然后使用它来获取Store对象（我认为每个PST文件将是一个Store ），然后是那里的Folder ，然后找到一些方法来创建MailItem使用您从eml文件解析的数据。
本文介绍如何使用Outlook自动化创建联系人和约会，并可能有用。
你可以使用Redemption 。 一些事情：
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
您可以在此处找到pst文件格式的规范。 但是我想你会花一些时间把它们放在一起来自己创建一个eml-> pst解析器。 但它应该是可能的。