Exportieren Sie Outlook Exchange-Ordner in das Windows-Dateisystem
517
Ryan Jacques
Derzeit wird ein VB-Makro zum Abrufen von E-Mail-Ordnern in das Windows-Dateisystem verwendet. Ordner, die auf einem Exchange-Server gespeichert sind, können jedoch nicht abgerufen werden. Ist dies überhaupt möglich? Verwenden Sie das VB-Skript unten
' SET STARTING FOLDER IN FODLER CHOOSER AS USERS [P DRIVE] Const STARTING_FOLDER = "P:" Dim objFSO As Object ' [COPY] THE OUTLOOK FOLDER Sub CopyOutlookFolderToFileSystem() ExportController "Copy" End Sub ' [MOVE] THE OUTLOOK FOLDER Sub MoveOutlookFolderToFileSystem() ExportController "Move" End Sub ' [USER] SELECTION OF FOLDER TO SAVE MESSAGES INTO ON SYSTEM Sub ExportController(strAction As String) Dim olkFld As Outlook.MAPIFolder, strPath As String strPath = SelectFolder(STARTING_FOLDER) If strPath = "" Then MsgBox "No Folder selected! Export cancelled.", vbInformation + vbOKOnly, "Export Outlook Folder" Else Set objFSO = CreateObject("Scripting.FileSystemObject") Set olkFld = Application.ActiveExplorer.CurrentFolder ExportOutlookFolder olkFld, strPath If LCase(strAction) = "move" Then olkFld.Delete End If Set olkFld = Nothing Set objFSO = Nothing End Sub ' FOR [ALL] MESSAGES IN THE FOLDER, EXPORT [ALL] MESSAGES Sub ExportOutlookFolder(ByVal olkFld As Outlook.MAPIFolder, strStartingPath As String) Dim olkSub As Outlook.MAPIFolder, olkItm As Object, strPath As String, strMyPath As String, strSubejct As String, intCount As Integer strPath = strStartingPath & "\" & olkFld.Name objFSO.CreateFolder strPath For Each olkItm In olkFld.Items strSubject = "[From] " & olkItm.SenderName & " [Subject] " & RemoveIllegalCharacters(olkItm.Subject) strFilename = strSubject & ".msg" intCount = 0 Do While True strMyPath = strPath & "\" & strFilename If objFSO.FileExists(strMyPath) Then intCount = intCount + 1 strFilename = strSubject & " (" & intCount & ").msg" Else Exit Do End If Loop olkItm.SaveAs strMyPath, olMSG ChangeTimeStamp strMyPath, olkItm.ReceivedTime Next For Each olkSub In olkFld.Folders ExportOutlookFolder olkSub, strPath Next Set olkFld = Nothing Set olkItm = Nothing End Sub Function SelectFolder(varStartingFolder As Variant) As String ' STANDARD ERROR HANDLING Dim objFolder As Object, objShell As Object On Error Resume Next ' CREATE A DIALOG OBJECT FOR FOLDER SELECTION & RETURN THE FOLDER [PATH] Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder(0, "Select the System folder you want to export to ...", 0, varStartingFolder) If TypeName(objFolder) <> "Nothing" Then SelectFolder = objFolder.self.Path ' STANDARD ERROR HANDLING Set objFolder = Nothing Set objShell = Nothing On Error GoTo 0 End Function Function RemoveIllegalCharacters(strValue As String) As String ' REMOVE [ALL CHARACTERS] THAT CANNOT BE CONTAINED IN A FILESYSTEM NAME RemoveIllegalCharacters = strValue RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "<", "") RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ">", "") RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ":", "") RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, Chr(34), "'") RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "/", "") RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "\", "") RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "|", "") RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "?", "") RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "*", "") End Function Sub ChangeTimeStamp(strFile As String, datStamp As Date) ' SAVE IN THE FILENAME THE [TIME] AND [DATE] OF THE [ORIGINAL] MESSAGE BEING SENT/RECIEVED Dim objShell As Object, objFolder As Object, objFolderItem As Object, varPath As Variant, varName As Variant varName = Mid(strFile, InStrRev(strFile, "\") + 1) varPath = Mid(strFile, 1, InStrRev(strFile, "\")) Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.NameSpace(varPath) Set objFolderItem = objFolder.ParseName(varName) objFolderItem.ModifyDate = CStr(datStamp) Set objShell = Nothing Set objFolder = Nothing Set objFolderItem = Nothing End Sub
1 Antwort auf die Frage
0
BastianW
Da Sie nicht angegeben haben, ob dies über ein Old-School-VB-Skript erfolgen muss, würde ich Exchange Webservices verwenden und die E-Mails dann auf einen Dateiserver exportieren. Sie benötigen hier keinen Outlook-Client. Sie müssen jedoch etwas in C # schreiben. Hier ist ein Beispiel:
private static void ExportMIMEEmail(ExchangeService service) { Folder inbox = Folder.Bind(service, WellKnownFolderName.Inbox); ItemView view = new ItemView(1); view.PropertySet = new PropertySet(BasePropertySet.IdOnly); // This results in a FindItem call to EWS. FindItemsResults<Item> results = inbox.FindItems(view); foreach (var item in results) { PropertySet props = new PropertySet(EmailMessageSchema.MimeContent); // This results in a GetItem call to EWS. var email = EmailMessage.Bind(service, item.Id, props); string emlFileName = @"C:\export\email.eml"; string mhtFileName = @"C:\export\email.mht"; // Save as .eml. using (FileStream fs = new FileStream(emlFileName, FileMode.Create, FileAccess.Write)) { fs.Write(email.MimeContent.Content, 0, email.MimeContent.Content.Length); } // Save as .mht. using (FileStream fs = new FileStream(mhtFileName, FileMode.Create, FileAccess.Write)) { fs.Write(email.MimeContent.Content, 0, email.MimeContent.Content.Length); } } }