Outlook распаковывает папки с электронной почтой внутри них на локальный жесткий диск

Предположим, у меня есть тонна папок, которые представляют разные категории сообщений электронной почты в Outlook. В каждой папке есть не менее тысячи сообщений электронной почты. Там также большое количество папок.Outlook распаковывает папки с электронной почтой внутри них на локальный жесткий диск

Если я хочу скопировать на жесткий диск папки с точными именами и файлами внутри, это не позволяет мне.

Мне нужно вручную создать папку на жестком диске для каждой папки в Outlook и затем скопировать все электронные письма в этой папке.

Любой способ сделать это быстрее? Любое кодирование VBA?

источник

2017-01-18 bogdanb

Я создаю новую папку вручную во время копирования вставив имени папки в мировоззрении, а затем скопировать содержимое из каждой папки Outlook. – bogdanb

Что вы подразумеваете под «содержанием»? Вы создаете файлы MSG или просто сохраняете вложения и тела? Если файлы MSG, как вы их называете? Если вы сохраняете вложения, как вы обрабатываете повторяющиеся имена? –

Использование FileSystemObject для проверки или создавать папки локально с Outlook, VBA

Path = "C:\Temp\" 
    If Not FSO.FolderExists(Path) Then 
     FSO.CreateFolder (Path) 
    End If

Вы также можете перебрать, чтобы получить папки Outlook см FolderPath и сосчитать все их содержимое затем использовать Mid и InStr, чтобы найти позицию и имя папки ..

Вот быстрый vba Пример. Я использую тему-строку как имя для сохранения и Regex.Replace, чтобы удалить недопустимые символы из темы.

Option Explicit 
Public Sub Example() 
    Dim Folders As New Collection 
    Dim EntryID As New Collection 
    Dim StoreID As New Collection 
    Dim Inbox As Outlook.MAPIFolder 
    Dim SubFolder As MAPIFolder 
    Dim olNs As NameSpace 
    Dim Item As MailItem 
    Dim RegExp As Object 
    Dim FSO As Object 

    Dim FolderPath As String 
    Dim Subject As String 
    Dim FileName As String 
    Dim Fldr As String 
    Dim Path As String 

    Dim Pos As Long 
    Dim ii As Long 
    Dim i As Long 


    Set olNs = Application.GetNamespace("MAPI") 
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox) 
    Set FSO = CreateObject("Scripting.FileSystemObject") 
    Set RegExp = CreateObject("vbscript.regexp") 

    Path = "C:\Temp\" 

    Call GetFolder(Folders, EntryID, StoreID, Inbox) 

    For i = 1 To Folders.Count 
     DoEvents 
     Fldr = Folders(i) 

     Pos = InStr(3, Fldr, "\") + 1 
      Fldr = Mid(Fldr, Pos) 

     FolderPath = Path & Fldr & "\" 
     Debug.Print FolderPath 

     If Not FSO.FolderExists(FolderPath) Then 
      FSO.CreateFolder (FolderPath) 
     End If 

     Set SubFolder = Application.Session.GetFolderFromID(EntryID(i), StoreID(i)) 

     For ii = 1 To SubFolder.Items.Count 
       DoEvents 
      Set Item = SubFolder.Items(ii) 

      ' Replace invalid characters with empty strings. 
      With RegExp 
       .Pattern = "[^\w\[email protected]]" 
       .IgnoreCase = True 
       .Global = True 
      End With 

      Subject = RegExp.Replace(Item.Subject, " ") 

      FileName = FolderPath & Subject & ".msg" 
      Item.SaveAs FileName, olMsg 

     Next ii 
    Next i 

End Sub 

Private Function GetFolder(_ 
     Folders As Collection, _ 
     EntryID As Collection, _ 
     StoreID As Collection, _ 
     Folder As MAPIFolder _ 
) 
    Dim SubFolder As MAPIFolder 
     Folders.Add Folder.FolderPath 
     EntryID.Add Folder.EntryID 
     StoreID.Add Folder.StoreID 

     For Each SubFolder In Folder.Folders 
      GetFolder Folders, EntryID, StoreID, SubFolder 
      Debug.Print SubFolder.Name ' Immediate Window 
     Next SubFolder 

     Set SubFolder = Nothing 

End Function

источник

2017-01-21 18:35:31 0m3r

Outlook распаковывает папки с электронной почтой внутри них на локальный жесткий диск

ответ

Смежные вопросы