跳到主要内容

如何将多封电子邮件中的所有附件保存到Outlook中的文件夹?

添加一名作者 最后修改时间:2022-06-16

使用Outlook中的内置“保存所有附件”功能,可以轻松保存电子邮件中的所有附件。 但是,如果要一次保存多封电子邮件中的所有附件,则没有直接功能可以提供帮助。 您需要在每封电子邮件中重复应用“保存所有附件”功能,直到从这些电子邮件中保存所有附件为止。 那很费时间。 在本文中,我们为您介绍了两种方法,可以在Outlook中轻松地将所有电子邮件中的所有附件批量保存到特定文件夹。

使用VBA代码将所有电子邮件中的所有附件保存到文件夹
只需单击几下,即可使用出色的工具将所有电子邮件中的所有附件保存到文件夹


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

本部分在分步指南中演示了VBA代码,可帮助您快速将所有附件从多封电子邮件中一次快速保存到特定文件夹。 请执行以下操作。

1.首先,您需要创建一个文件夹,用于将附件保存在计算机中。

进入 文件 文件夹并创建一个名为 “附件”。 看截图:

2.选择要保存附件的电子邮件,然后按 其他 + F11 键打开 Microsoft Visual Basic应用程序 窗口。

3。 点击 插页 > 模块 打开 模块 窗口,然后将以下VBA代码之一复制到窗口中。

VBA代码1:批量保存多封电子邮件中的附件(直接保存名称完全相同的附件)

Tips:此代码通过在文件名后添加数字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

:

1)如果要将所有相同名称的附件保存在文件夹中,请应用上面的内容 VBA代码1。 在运行此代码之前,请单击 工具 > 参考资料,然后检查 Microsoft脚本运行时参考-项目 对话框;

doc保存附件07

2)如果要检查重复的附件名称,请应用VBA代码2。运行该代码后,将弹出一个对话框,提醒您是否替换重复的附件,选择 Premium Partner or 没有 根据您的需求。

5。 按 F5 键来运行代码。

然后所选电子邮件中的所有附件都将保存到您在步骤 1 中创建的文件夹中。 

笔记: 可能有一个 微软Outlook 弹出提示框,请点击 按钮继续。


使用出色的工具将所有电子邮件中的所有附件保存到文件夹

如果您是VBA的新手,强烈建议您 保存所有附件 实用程序 Outook 的 Kutools 为了你。 使用此实用程序,只需单击几次即可在Outlook中快速快速地一次保存多封电子邮件中的所有附件。
在应用此功能之前,请 首先下载并安装Kutools for Outlook.

1.选择包含您要保存的附件的电子邮件。

提示: 您可以按住来选择多个不相邻的电子邮件 按Ctrl 键并一一选择;
或选择多个相邻的电子邮件,方法是按住 转移 键,然后选择第一个电子邮件和最后一个电子邮件。

2。 点击 库工具 >附件工具全部保存。 看截图:

3.在 保存设置 对话框中,单击 按钮以选择一个文件夹来保存附件,然后单击 OK 按钮。

3。 点击 OK 在下一个弹出对话框中两次,然后将所选电子邮件中的所有附件立即保存在指定的文件夹中。

笔记:

  • 1.如果您想根据电子邮件将附件保存在不同的文件夹中,请检查 按照以下样式创建子文件夹 框,然后从下拉菜单中选择文件夹样式。
  • 2.除了保存所有附件,您还可以按特定条件保存附件。 例如,您只想保存文件名中包含“发票”字样的pdf文件附件,请单击 高级选项 按钮以扩展条件,然后将其配置为如下所示的屏幕快照。
  • 3.如果要在电子邮件到达时自动保存附件,则 自动保存附件 功能可以提供帮助。
  • 4.要直接从所选电子邮件中分离附件,请 分离所有附件 的特点 Kutools for Outlook 可以帮你一个忙。

  如果您想免费试用(30天)此实用程序, 请点击下载,然后按照上述步骤进行操作。


相关文章

在Outlook中的电子邮件正文中插入附件
通常,附件显示在撰写电子邮件的“附件”字段中。 在这里,本教程提供了一些方法来帮助您轻松地在Outlook的电子邮件正文中插入附件。

自动将附件从Outlook下载/保存到特定文件夹
通常,您可以通过单击Outlook中的附件>保存所有附件来保存一封电子邮件的所有附件。 但是,如果您需要保存所有收到的电子邮件和收到的电子邮件中的所有附件,那么理想吗? 本文将介绍两种解决方案,可以将附件从Outlook自动下载到特定文件夹。

在Outlook中以一封/多封电子邮件打印所有附件
如您所知,当您在Microsoft Outlook中单击“文件”>“打印”时,它将仅打印电子邮件内容,例如标题,正文,而不会打印附件。 在这里,我们将向您展示如何在Microsoft Outlook中轻松打印所选电子邮件中的所有附件。

在Outlook中的附件(内容)中搜索词
当我们在Outlook的“即时搜索”框中键入关键字时,它将在电子邮件的主题,正文,附件等中搜索关键字。但是现在,我只需要在Outlook中仅在附件内容中搜索关键字,您知道吗? 本文介绍了在Outlook中轻松搜索附件内容中的单词的详细步骤。

在Outlook中回复时保留附件
当我们在Microsoft Outlook中转发电子邮件时,此电子邮件中的原始附件将保留在转发的邮件中。 但是,当我们回复电子邮件时,原始附件将不会附加在新的回复消息中。 在这里,我们将介绍有关在Microsoft Outlook中回复时保留原始附件的一些技巧。


最佳办公生产力工具

最新消息:Kutools for Outlook 发布 免费版本!

体验全新的 Kutools for Outlook 免费版本拥有 70 多项令人难以置信的功能,您可以永久使用! 点击立即下载!

🤖 Kutools人工智能 : 具有人工智能魔力的即时专业电子邮件——一键天才回复、完美语气、多语言掌握。轻松改变电子邮件! ...

📧 电子邮件自动化: 自动回复(适用于 POP 和 IMAP)  /  安排发送电子邮件  /  发送电子邮件时按规则自动抄送/密件抄送  /  自动转发(高级规则)   /  自动添加问候语   /  自动将多收件人电子邮件拆分为单独的消息 ...

📨 电子邮件管理: 撤回电子邮件  /  按主题和其他人阻止诈骗电子邮件  /  删除重复的电子邮件  /  高级搜索  /  合并文件夹 ...

📁 附件专业版批量保存  /  批量分离  /  批量压缩  /  自动保存   /  自动分离  /  自动压缩 ...

🌟 界面魔法: 😊更多又漂亮又酷的表情符号   /  收到重要邮件时提醒您  /  最小化 Outlook 而不是关闭 ...

👍 一键奇迹: 使用传入附件回复全部  /   反网络钓鱼电子邮件  /  🕘显示发件人的时区 ...

👩🏼‍🤝‍👩🏻 通讯录和日历: 从选定的电子邮件中批量添加联系人  /  将联系人组拆分为各个组  /  删除生日提醒 ...

只需单击一下即可立即解锁 Kutools for Outlook -永久免费. 别等了, 立即下载并提高您的效率!

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

 

 

Comments (81)
Rated 3.5 out of 5 · 3 ratings
This comment was minimized by the moderator on the site
Thank you for sharing the code. Unfortunately, I tried both with failure. This is what I got - The macros in this project are disabled. Please refer to the online help or documentation of the host application to determine how to enable macros. Thank you.
This comment was minimized by the moderator on the site
Hi,
Please follow the instructions in the screenshot below to check if macros are enabled in the macro settings in your Outlook. After enabling both options, re-run the VBA code.

https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/macro-enabled.png
This comment was minimized by the moderator on the site
Thank you so much.
Rated 5 out of 5
This comment was minimized by the moderator on the site
Thank you for sharing VBA code. This work like magic and is going to save it lots of time!
This comment was minimized by the moderator on the site
Hello friends!

Thanks for sharing this VBA code.

Is there any way to change the location of the save folder?

I share the pc with some colleagues and in this case I need the files to be saved in a password protected folder which is not located in the documents folder.

How can I make this change?

Thank you in advance
This comment was minimized by the moderator on the site
Hi Fabiana,
Change the line 14
xFolderPath = xFolderPath & "\Attachments\"

to
xFolderPath = "C:\Users\Win10x64Test\Desktop\save attachments\1\"

Here "C:\Users\Win10x64Test\Desktop\save attachments\1\" is the folder path in my case.
Don't forget to end the folder path with a slash "\"
This comment was minimized by the moderator on the site
Hello friends!

Thank you for sharing that VBA code.

Is there any way to change the location of the save folder?

I share the pc with some colleagues and in this case I need the files to be saved in a password protected folder which is not located in the documents folder.

How can I make this change?

Thank you in advance
There are no comments posted here yet
Load More
Leave your comments
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations