KutoolsforOffice — 一套方案，五大工具。事半功倍。三月特賣：20% 折扣

如何將多封郵件中的所有附件儲存至 Outlook 資料夾？

作者Siluvia修改日期

在 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」。執行此程式碼前，請點選「工具」>「參考設定」，然後在「參考設定 —— 專案」對話方塊中勾選「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」>「附件工具」>「儲存全部」。請參閱下方截圖：

在「儲存設定」對話方塊中，按一下選項按鈕按鈕，選擇附件的儲存資料夾，再點選「確定」按鈕即可完成設定！

透過 kutools for outlook 儲存附件 1

4. 在接下來彈出的對話方塊中連續點擊兩次「確定」，所選郵件中的所有附件便會一次性儲存至指定資料夾。

注意事項：

  • 1. 若您希望根據電子郵件將附件儲存至不同資料夾，請勾選「以下列樣式建立子資料夾」核取方塊，並從下拉式清單中選擇合適的資料夾樣式。
  • 2. 除了儲存所有附件外，您還能根據特定條件篩選並儲存附件。例如，若您只想儲存檔名包含「Invoice」一詞的 PDF 檔案，請點擊「高級選項」按鈕展開條件設定，並依下圖所示進行配置。
  • 3. 若您希望在郵件抵達時自動儲存附件，自動保存附件功能可助您輕鬆達成此目的！
  • 4. 若要直接從所選郵件中分離附件，分離所有附件——「Kutools for Outlook」的這項功能可助您一臂之力！

相關文章

在 Outlook 電子郵件訊息本文中插入附件
一般而言，附件會顯示於撰寫郵件時的「附加檔案」欄位中。本教學提供多種方法，助您輕鬆將附件插入 Outlook 郵件本文！

自動將 Outlook 附件下載／儲存至指定資料夾
一般來說，您可於 Outlook 中點選「附件」>「儲存所有附件」，手動儲存單封郵件的所有附件。但若您希望自動將所有已接收及正在接收的郵件附件儲存至指定資料夾，該如何實現？本文將為您介紹兩種實用方案，助您輕鬆達成自動化儲存！

在 Outlook 中列印一封或多封郵件的所有附件
眾所周知，在 Microsoft Outlook 中點選「檔案」＞「列印」時，僅會列印郵件內容（如標頭與本文），而不會列印附件。本文將示範如何在 Microsoft Outlook 中輕鬆列印所選郵件的所有附件，助您提升效率、省時又省力！

在 Outlook 中搜尋附件（內容）內的文字
當您在 Outlook 的搜尋方塊中輸入關鍵字時，系統會自動於郵件主旨、本文及附件內容中進行搜尋。但若您只想專注於在 Outlook 附件內容中查找關鍵字，該如何操作？本文將逐步說明如何輕鬆達成此目標！

在 Outlook 中回覆郵件時保留附件
當您在 Microsoft Outlook 中轉寄郵件時，原始郵件中的附件會自動保留在轉寄訊息中。然而，當您回覆郵件時，原始附件並不會自動附加至新回覆訊息中。本文將為您介紹幾種實用技巧，協助您在 Microsoft Outlook 中回覆郵件時輕鬆保留原始附件！

最佳 Office 生產力工具

體驗全新 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