Tip: Other languages are Google-Translated. You can visit the English version of this link.
Log in




Kutools for Outlook: 100+ New Advanced Tools for Outlook.
Office Tab: Enable Tabbed Editing and Browsing in Office, Just Like Chrome, Firefox, IE 8/9/10.
Classic Menu: Bring Old Menus and Toolbars Back to Office 2007, 2010, 2013, 2016 and 2019.

arrow blue right bubble 运行VBA将多封邮件中的附件批量保存到文件夹中

1. 首先,在电脑里创建一个将要保存附件的文件夹。文件夹路径应如下图所示:MarsPC是windows用户名,Attachments为文件夹名。

2. 创建文件夹后,回到Outlook界面,按住键盘上的Alt 和F11键打开Microsoft Visual Basic for Applications窗口。

3. 点击插入 > 模块打开模块窗口,然后将下面VBA代码粘贴到新打开的模块窗口里。


Public Sub SaveAttachments()
'Update 20141121
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem
    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
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    Set objOL = CreateObject("Outlook.Application")
    Set objSelection = objOL.ActiveExplorer.Selection
    strFolderpath = strFolderpath & "\Attachments\"
    For Each objMsg In objSelection
        Set objAttachments = objMsg.Attachments
        lngCount = objAttachments.Count
        strDeletedFiles = ""
        If lngCount > 0 Then
            For i = lngCount To 1 Step -1
                strFile = objAttachments.Item(i).FileName
                strFile = strFolderpath & strFile
                objAttachments.Item(i).SaveAsFile strFile
                If objMsg.BodyFormat <> olFormatHTML Then
                    strDeletedFiles = strDeletedFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                    strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
                    strFile & "'>" & strFile & "</a>"
                End If
                Next i
                If objMsg.BodyFormat <> olFormatHTML Then
                    objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body
                    objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody
                End If
            End If
        Set objAttachments = Nothing
        Set objMsg = Nothing
        Set objSelection = Nothing
        Set objOL = Nothing
    End Sub

4. 打开Outlook的邮件视图,选中带附件邮件。

5. 返回Microsoft Visual Basic for Applications窗口,点击运行按钮(或者点击F5键)运行代码。

6. 当下图所示对话框弹出时,点击Allow按钮。


7. 所有附件保存成功后,最后的保存结果如下图所示。你可以点击对应的保存路径找到已保存的附件。

arrow blue right bubble 运行Kutools for Outlook快速地将多封邮件中的附件保存到文件夹中

Kutools for Outlook的拆离所有功能可以帮你在Outlook里快速地保存多封邮件里的附件。

Kutools for Outlook - 让你在 Outlook 里的工作更简单、更快捷!批量保存/压缩附件、高级打印、自动答复\转发\拦截垃圾邮件、删除重复项,等等……

1. 打开邮件文件夹,在邮件列表里选择多封带附件的邮件。

2. 点击Kutools > 其他功能 > 拆离所有。见下图:

3. 在拆离所有对话框里,点击


注意:第一次运行该功能时,点击Kutools > 其他功能 > 拆离所有后会弹出浏览文件夹对话框,你需要在此对话框里指定保存附件的文件夹。


Recommended Productivity Tools

shot kutools outlook kutools tab 1180x121
shot kutools outlook kutools plus tab 1180x121

Kutools for Outlook - More than 100 Advanced Functions for Outlook, Improve 70% Efficiency For you

  • Complicated and repeated operations can be done a one-time processing in seconds.
  • Forward multiple emails individually with one-click, and auto forward by rules.
  • Auto CC/BCC every sending email and easy for customizing rules, and auto reply without requiring exchange server.
  • Powerful junk emails filter, remove duplicate emails, reply with attachment, bunch of one-click operations, and so on...
  • 60-day unlimited free trial. 60-day money back guarantee. 2 years free upgrade and support. Buy once, use forever.
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.

Be the first to comment.