Экспорт папок Outlook Exchange в файловую систему Windows
401
Ryan Jacques
В настоящее время используется макрос VB для перетаскивания папок электронных писем в файловую систему Windows, но он не может извлекать папки, хранящиеся на сервере обмена. Возможно ли это? Используя скрипт VB ниже
' 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 ответ на вопрос
0
BastianW
Поскольку вы не указали, ДОЛЖЕН ли это быть сделано с помощью скрипта VB старой школы ... Я бы использовал Exchange Webservices, а затем экспортировал электронные письма таким образом на файловый сервер. Вам не нужен клиент Outlook здесь. Однако вам нужно что-то написать на C #. Вот пример:
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); } } }