KutoolsforOffice — 一套方案，五大工具。事半功倍。

如何在 Outlook 中将多封邮件的所有附件一次性保存到指定文件夹？

作者Siluvia修改日期

在 Outlook 中，借助内置的“全部保存附件”功能，您可以轻松保存一封邮件中的所有附件。然而，如果您希望一次性保存多封邮件中的所有附件，目前 Outlook 并未提供直接支持的功能，您需要在每封邮件中重复操作“全部保存附件”，直到全部附件保存完毕，这无疑非常耗时。本文将为您介绍两种简便方法，助您轻松批量保存多封邮件中的所有附件至指定文件夹。

使用 VBA 代码将多封邮件中的所有附件保存到文件夹
仅需几次点击，用强大工具将多封邮件的所有附件保存到文件夹

使用 VBA 代码将多封邮件中的所有附件保存到文件夹

本节将通过分步指南，演示如何利用 VBA 代码，帮助您一键将多封邮件中的所有附件批量保存到指定文件夹。请按照以下步骤操作。

1. 首先，请在您的电脑上创建一个用于保存附件的文件夹。

进入“文档”文件夹后，新建一个名为“Attachments”的文件夹，如下图所示：

通过 vba 保存附件 1

2. 选中包含您要保存附件的邮件后，按下“Alt”+“F11”组合键，即可打开“Microsoft Visual Basic for Applications”窗口。

3. 点击“插入”>“模块”，打开“模块”窗口后，将以下任意一段 VBA 代码粘贴到窗口中。

VBA 代码 1：批量保存多封邮件的附件（直接保存同名附件）

提示：此代码会通过添加数字 1、2、3…… 文件名称后的方式保存同名附件。

Dim GCount As Integer
Dim GFilepath As String
Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
GFilepath = ""
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            GCount = 0
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            GFilepath = xFilePath
            xFilePath = FileRename(xFilePath)
            If IsEmbeddedAttachment(xAttachments.Item(i)) = False Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As FileSystemObject
On Error Resume Next
Set xFso = CreateObject("Scripting.FileSystemObject")
xPath = FilePath
FileRename = xPath
If xFso.FileExists(xPath) Then
    GCount = GCount + 1
    xPath = xFso.GetParentFolderName(GFilepath) & "\" & xFso.GetBaseName(GFilepath) & " " & GCount & "." + xFso.GetExtensionName(GFilepath)
    FileRename = FileRename(xPath)
End If
xFso = Nothing
End Function

Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = ""
xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCid <> "" Then
    xHtml = xItem.HTMLBody
    xID = "cid:" & xCid
    If InStr(xHtml, xID) > 0 Then
        IsEmbeddedAttachment = True
    End If
End If
End Function
VBA 代码 2：批量保存多封邮件附件（检查重复项）
Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
Dim xYesNo As Integer
Dim xFlag As Boolean
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            xFlag = True
            If VBA.Dir(xFilePath, 16) <> Empty Then
                xYesNo = MsgBox("The file is exists, do you want to replace it", vbYesNo + vbInformation, "Kutools for Outlook")
                If xYesNo = vbNo Then xFlag = False
            End If
            If xFlag = True Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub
通过 vba 保存附件 2

注意：

1）如果您希望在一个文件夹中保存所有同名附件，请使用以上“VBA 代码 1”。运行代码前，请点击“工具”>“引用”，并在“引用 —— Project”对话框中勾选“Microsoft Scripting Runtime”。
通过 vba 保存附件 3
2）如果您需要检查附件名称是否重复，请使用“VBA 代码 2”。代码运行后，会弹出一个对话框提醒您是否替换重复附件，请根据需求选择“是”或“否”。

5. 按下“F5”键即可运行代码。

随后，所有选中的邮件附件将被统一保存至您在第 1 步创建的文件夹中。

注意：操作过程中可能会弹出“Microsoft Outlook”提示框，请点击“允许”按钮以继续。

用强大工具将多封邮件的所有附件保存到文件夹

如果您不熟悉 VBA，强烈推荐使用 Kutools for Outlook 的“全部保存附件”实用工具。借助此工具，您只需几次点击，即可在 Outlook 中一键快速保存多封邮件的所有附件。

告别 Outlook 低效！Kutools for Outlook 助您高效批量处理邮件——现已推出 30 天免费试用！立即下载 Kutools for Outlook！！

1. 选择包含所需保存附件的邮件。

提示：按住“Ctrl”键逐一点击，可多选不连续邮件；
或按住“Shift”键，先选中第一封邮件，再选中最后一封，即可多选连续邮件。

2. 点击“KUTOOLS PLUS”>“附件工具”>“全部保存”。如图所示：

3. 在“保存设置”对话框中，点击选项按钮按钮选择要保存附件的文件夹，然后点击“确定”按钮。

通过 kutools for outlook 保存附件 1

4. 在接下来的弹出对话框中，连续点击两次“确定”，即可将所有选中的邮件附件一次性保存到指定文件夹中。

注意：

  • 1. 如果您希望根据不同邮件将附件分别保存到不同的文件夹，请勾选“以以下方式创建子文件夹”复选框，并从下拉列表中选择所需的文件夹样式。
  • 2. 除了能够保存所有附件外，您还可以根据特定条件筛选并保存附件。例如，如果您只需保存文件名中包含“Invoice”字样的 PDF 附件，只需点击“高级选项”按钮展开条件设置，并按照下方所示进行配置。
  • 3. 如果您想在邮件到达时自动保存附件，自动保存附件功能即可帮您轻松实现。
  • 4. 如果您想直接从选中的邮件中分离附件，全部分离附件的全部分离附件功能可以帮您轻松实现。

相关文章

在 Outlook 邮件正文中插入附件
通常在撰写邮件时，附件会显示在“附件”字段。本文将为您介绍多种方法，助您轻松将附件插入 Outlook 邮件正文中。

自动从 Outlook 下载/保存附件到指定文件夹
通常，您可以在 Outlook 中点击附件 > 全部保存附件，批量保存一封邮件的所有附件。但如果您想将所有收到的邮件及其附件自动保存到指定文件夹，有什么高效的方法吗？本文将为您介绍两种解决方案，助您轻松实现 Outlook 附件自动下载到指定文件夹。

在 Outlook 中打印一封或多封邮件的全部附件
众所周知，在 Microsoft Outlook 中点击“文件 > 打印”时，只会打印邮件的抬头和正文，附件内容无法直接打印。本文将为您详细演示如何在 Microsoft Outlook 中轻松打印所选邮件的全部附件。

在 Outlook 附件内容中搜索关键词
在 Outlook 的搜索框中输入关键词时，系统会在邮件主题、正文和附件等位置进行搜索。但如果您只想在附件内容中查找关键词，该如何操作？本文将为您详细介绍如何在 Outlook 中轻松搜索附件内容中的关键词。

在 Outlook 回复邮件时保留附件
在 Microsoft Outlook 中转发邮件时，原始邮件的附件会自动保留在转发邮件中。但在回复邮件时，原始附件不会自动附加到新回复消息中。本文将为您介绍几种方法，帮助您在 Microsoft Outlook 回复邮件时也能保留原始附件。

最佳办公效率工具

体验全新 Kutools for Outlook，畅享 100+ 强大功能！立即点击下载，不容错过！

🤖KUTOOLS AI：采用先进 AI 技术，轻松处理邮件，涵盖回复、摘要、优化、扩展、翻译及撰写等功能。

📧 邮件自动化：自动答复（支持 POP 和 IMAP）/定时发送邮件/发送邮件时按规则自动抄送密送/自动转发（高级规则）/自动添加称呼/自动将多收件人邮件拆分为单独信息……

📨 邮件管理：撤回邮件/按主题等条件拦截诈骗邮件/删除重复邮件/高级搜索/整合文件夹……

📁 附件增强：批量保存/批量分离/批量压缩/自动保存/自动拆离/自动压缩……

🌟 界面魔法：😊更多美观时尚表情/重要邮件到达时提醒您/最小化 Outlook 而不是直接关闭……

👍 一键精彩功能：带附件全部答复/反钓鱼邮件/🕘显示发送者当前时间时区……

👩🏼‍🤝‍👩🏻 联系人与日历：批量从选定邮件中提取添加联系人/将联系人组拆分为个人组/移除生日提醒……

在您的首选语言中畅享 Kutools —— 支持英语、西班牙语、德语、法语、中文等 40 多种语言！

一键解锁 Kutools for Outlook，告别等待，立即下载，让效率倍增！

kutools for outlook 功能1kutools for outlook 功能2

🚀 一键下载 — 即可获取全部 Office 加载项

强烈推荐：Kutools for Office（5 合 1）

一键下载五个安装包，即可同时获得 Kutools for Excel、Outlook、Word、PowerPoint 和 Office Tab Pro。立即点击下载！

  • ✅ 一键便捷：只需一次操作，即可下载全部五个安装包。
  • 🚀 轻松应对各类 Office 任务：随时按需安装所需插件，助您高效办公，不容错过！
  • 🧰 包含：Kutools for Excel / Kutools for Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint