Outlook将包含电子邮件的文件夹提取到本地硬盘

Question

假设我有很多文件夹，它们代表Outlook中不同类别的电子邮件。每个文件夹至少有一千封电子邮件。还有大量的文件夹。

如果我想复制到硬盘驱动器的文件夹与确切的名称和文件里面，它不允许我。

我必须在硬盘上为Outlook中的每个文件夹手动创建一个文件夹，然后复制该文件夹中的所有电子邮件。

有什么办法做得更快吗？有VBA编码解决方案吗？

Answer 1

使用FileSystemObject从Outlook vba 本地检查或创建文件夹

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

---

您还可以循环查看Outlook文件夹、FolderPath及其所有内容计数，然后使用Mid和InStr查找位置和文件夹名称。。

这是一个快速的vba示例，我使用Subject行作为保存名称，并使用Regex.Replace从Subject行中删除无效字符。

---

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.@-]"
.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