Exportar pastas do Outlook para o sistema de arquivos do Windows

Question

Atualmente, usando a macro A VB para extrair pastas de e-mails para o sistema de arquivos do Windows, mas não é possível extrair pastas armazenadas em um servidor Exchange, isso é possível? Usando o script VB abaixo

' 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

    

Answer 1

Como você não especificou se isso DEVE ser feito via script VB da velha escola ... eu usaria Exchange Webservices e depois exportar os e-mails desse modo para um servidor de arquivos. Você não precisa de um cliente do Outlook aqui. No entanto, você precisa escrever algo em c #. Aqui é um exemplo:

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);
        }
    }
}