批量保存 Outlook 附件（相同名称附件处理）

1.需求描述

最近出差比较多，有大量通行费及相关发票产生，都发送到邮箱里面，需要将其保存下来发给公司财务，手动一个个保存太慢，在网上找了一些用VBA处理的方式，但由于有些附件名称相同，在保存时多个附件只能保存一个。因此手动改写了一个能用的供大家参考。

2.实现步骤

1. 在outlook收件箱中创建一个attachment的文件夹。采用规则或手动将需要保存的附件邮件全部移入该文件夹中。

2. 打开 Outlook 的选项，进入信任中心，打开信任中心设置，点击宏设置后选中启用所有宏点确定保存（等会记得改回去）

打开 Outlook 的选项，进入自定义功能区，点击开发工具后选中点确定保存。

3. 回到Outlook 菜单栏中多出开发工具选项，点击宏，输入宏名保存附件(可以自己用其它名称)，点击创建，打开Vba在里面输入如下代码：

代码如下：

Sub 保存附件()

Dim olApp As New Outlook.Application

Dim nmsName As Outlook.NameSpace

Dim vItem As Object

Dim mailIndex As Integer

mailIndex = 0

Set nmsName = olApp.GetNamespace("MAPI")

Set myFolder = nmsName.GetDefaultFolder(olFolderInbox)

Set fldFolder = myFolder.Folders("attachment")

For Each vItem In fldFolder.Items

'-----Save Attachment-------

For Each att In vItem.Attachments

att.SaveAsFile "D:\attachment download\" & CStr(mailIndex) & att.FileName

Next

'------Save Attachment--------
mailIndex = mailIndex + 1

Next

Set fldFolder = Nothing

Set nmsName = Nothing

End Sub

4. 回到Outlook 菜单栏中多出开发工具选项，点击宏，点击运行。

5. 可以看到需要保存的文件已经保存到D盘中 attachment download的位置。有相同名称的附件前面都加了前缀，进行区分。

3.补充说明

如果需要其它存储路径，仅需要手动修改代码中的下图的位置路径即可。