使用 Outlook VBA 批量保存MSG格式邮件

使用下面的程序，可以实现将选中的邮件以MSG的格式批量保存到指定的目录下。每个文件会以收到的时间命名。

Function DateToString(d As Date) As String
Dim s As String
s = Format([d], "yyyymmddhhnnss")
DateToString = s
End Function

Sub SaveSelMails()
Dim objItem As Object
Dim strPath As String
Dim strFilename As String

'Exit if you don't choose any files
If ActiveExplorer.Selection.Count = 0 Then Exit Sub

strPath = InputBox("Please enter the full path:", "Enter path")

'write all the chosen emails to the path
For Each objItem In ActiveExplorer.Selection
strFilename = DateToString(objItem.ReceivedTime)
objItem.SaveAs strPath & strFilename & ".msg", olMSGUnicode
Next

MsgBox "Email text extraction completed!", vbOKOnly + vbInformation, "DONE!"
Set objItem = Nothing
End Sub

需要注意的是，输入时要输入以 '\' 结尾的字符串，比如： ‘c:\tmp\’

此外，还有更简单的方式：在Outlook中使用Ctrl+左键选中邮件之后，直接拖拽到目录中。