在 Outlook 中一次保存多封电子邮件的附件？

Question

有人一夜之间给我发了 200 封电子邮件，每封都带有一个文件附件。叹

我预计接下来的三个晚上每晚还会收到 200 封电子邮件（这些电子邮件来自服务器，因此要求他们进行批处理是不现实的）。

文件附件具有唯一的文件名，那么有没有一种简单的方法可以一次保存整个电子邮件组的附件？

我不愿意逐个打开每封电子邮件，右键单击、保存、冲洗、重复......

我精通 VBA，非常擅长创建 Excel 宏，因此我可以想象遍历给定文件夹中的所有消息并保存每个消息的附件应该相对容易，但我以前没有编写过 Outlook 宏，不熟悉对象层次结构。

Answer 1

NirSoft 的Outlook附加视图可以轻松完成此操作，甚至可以通过命令行完成！

OutlookAttachView 会扫描 Outlook 中存储的所有邮件，并显示找到的所有附件列表。您可以轻松选择一个或多个附件，并将它们全部保存到所需文件夹中，还可以删除邮箱中占用过多磁盘空间的不需要的大型附件。您还可以将附件列表保存到 xml/html/text/csv 文件中。

OutlookAttachView 是免费软件。

Answer 2

Outlook 附件删除插件：

免费的 Outlook 插件，用于保存和提取附件，减少 Outlook 文件的大小。易于使用。功能丰富。

Answer 3

这里还有一些其他选项。

Sue Mosher 的网站http://slipstick.com是 Outlook 的优秀资源。她还是 Microsoft MVP。

对于你们这些程序员来说：将附件保存到硬盘或者 使用 VBA 保存和打开附件。

以下代码适用于 Outlook 2000 及更高版本。它保存选定邮件中的附件，但不会从邮件中删除附件。

…

将此页面的代码复制并粘贴到您的 ThisOutlookSession 项目中。

在 Outlook 中，按 Alt+F11 打开 VBA 编辑器并展开 Microsoft Outlook 对象，然后双击 ThisOutlookSession 在编辑窗格中打开它，然后按 Ctrl+V 粘贴代码。

要使用它，您必须首先在“我的文档”下创建一个名为 OLAttachments 的文件夹（代码不会为您创建它）。然后选择一个或多个消息并运行宏以保存附件。您需要将宏安全性设置为在启用宏之前发出警告或对宏进行签名。您可以通过编辑代码来更改保存附件的文件夹名称或路径。

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")

    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection

' The attachment folder needs to exist
' You can change this to another folder name of your choice

    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "\OLAttachments\"

    ' Check each selected item for attachments. 
    For Each objMsg In objSelection

    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count

    If lngCount > 0 Then

    ' Use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.

    For i = lngCount To 1 Step -1

    ' Get the file name.
    strFile = objAttachments.Item(i).FileName

    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile

    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile

    Next i
    End If

    Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

如果你不想编程：Outlook 附件管理工具

Answer 4

旧帖子，但我觉得它至今仍然有意义。这是 Chatgpt 帮我写的代码。它保存来自多封电子邮件（pdf 等）的所有附件，并使用随机数将它们保存并重命名到您的 PC 文件夹中，该文件夹必须名为“OLATTACHMENTS”。这允许最多保存 250 次，因为当我达到这个高度时，Outlook 会冻结约 2 分钟。这是代码，必须将其放入开发人员--Visual Basic 中：

Public Sub SaveAttachments()
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem 'Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolderpath As String
    Dim strDeletedFiles As String
    
    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next
    
    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")
    
    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection
    
    ' The attachment folder needs to exist
    ' You can change this to another folder name of your choice
    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "\OLAttachments\"
    
    ' Check each selected item for attachments.
    For Each objMsg In objSelection
        Set objAttachments = objMsg.Attachments
        lngCount = objAttachments.Count
        
        If lngCount > 0 Then
            ' Use a count down loop for removing items
            ' from a collection. Otherwise, the loop counter gets
            ' confused and only every other item is removed.
            For i = lngCount To 1 Step -1
                ' Get the file name.
                strFile = objAttachments.Item(i).FileName
                
                ' Generate a unique file name by appending a timestamp and a random number
                Dim timestamp As String
                timestamp = Format(Now, "yyyymmddhhmmss")
                Dim randomNumber As Integer
                randomNumber = Int((9999 - 1000 + 1) * Rnd + 1000)
                Dim fileExtension As String
                fileExtension = Right(strFile, Len(strFile) - InStrRev(strFile, "."))
                strFile = Left(strFile, InStrRev(strFile, ".") - 1) & "_" & timestamp & "_" & randomNumber & "." & fileExtension
                
                ' Combine with the path to the Temp folder.
                strFile = strFolderpath & strFile
                
                ' Save the attachment as a file.
                objAttachments.Item(i).SaveAsFile strFile
            Next i
        End If
    Next objMsg
    
ExitSub:
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
End Sub