如何在Outlook中將郵件的附件重新命名並保存到文件夾中？

Author: Sun Last Modified: 2025-08-06

在Outlook中，您通常會收到帶有附件的郵件。您是否嘗試過將郵件中的附件重新命名並將它們保存到某個文件夾中，如下方截圖所示？顯然，您可以將它們逐一保存到文件夾中並逐一手動重命名，但實際上，我有一段VBA代碼可以快速將所有附件以相同名稱重新命名，然後保存到同一文件夾中。
doc rename save attach 1

以相同名稱重新命名並將附件保存到文件夾中

使用Kutools for Outlook將附件重新命名並保存到文件夾中

以相同名稱重新命名並將附件保存到文件夾中

1. 選擇您要保存其附件並將其重新命名為相同名稱的郵件。

2. 按下「Alt」+「F11」鍵，在「Project1」窗格中雙擊「ThisOutlookSession」以在右側部分創建一個新的空白腳本，然後將代碼複製並粘貼到其中。

VBA：重新命名並保存附件

Public Sub SaveAttachsToDisk()
'UpdatebyExtendoffice20180521
Dim xItem As Object  'Outlook.MailItem
Dim xSelection As Selection
Dim xAttachment As Outlook.Attachment
Dim xFldObj As Object
Dim xSaveFolder As String
Dim xFSO As Scripting.FileSystemObject
Dim xFile As File
Dim xFilePath As String
Dim xNewName, xTmpName As String
Dim xExt As String
Dim xCount As Integer
On Error Resume Next
Set xFldObj = CreateObject("Shell.Application").browseforfolder(0, "Select a Folder", 0, 16)
Set xFSO = New Scripting.FileSystemObject
If xFldObj Is Nothing Then Exit Sub
xSaveFolder = xFldObj.Items.Item.Path & "\"
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xNewName = InputBox("Attachment Name:", "Kutools for Outlook", xNewName)
If Len(Trim(xNewName)) = 0 Then Exit Sub
For Each xItem In xSelection
    For Each xAttachment In xItem.Attachments
        xFilePath = xSaveFolder & xAttachment.FileName
        xAttachment.SaveAsFile xFilePath
        Set xFile = xFSO.GetFile(xFilePath)
        xCount = 1
        Saved = False
        xExt = "." & xFSO.GetExtensionName(xFilePath)
        xTmpName = xNewName
        xNewName = xTmpName & xExt
        If xFSO.FileExists(xSaveFolder & xNewName) = False Then
            xFile.Name = xNewName
            xNewName = xTmpName
        Else
            xTmpName = Left(xNewName, Len(xNewName) - Len(xExt))
            While Saved = False
                xNewName = xTmpName & xCount & xExt
                If xFSO.FileExists(xSaveFolder & xNewName) = False Then
                    xFile.Name = xNewName
                    xNewName = xTmpName
                    Saved = True
                Else
                    xCount = xCount + 1
                End If
            Wend
        End If
    Next
Next
Set xFSO = Nothing
End Sub

doc rename save attachments in a folder 2

3. 點擊「工具」>「引用」，在彈出的對話框中勾選「Microsoft Script Runtime」複選框。

doc rename save attachments in a folder 3

doc rename save attachments in a folder 4

4. 點擊「確定」，按下「F5」鍵運行代碼，隨後會彈出「瀏覽文件夾」對話框，供您選擇或創建一個用於放置附件的文件夾。
doc rename save attachments in a folder 5

5. 點擊確定，然後為附件命名。
doc rename save attachments in a folder 6

6. 點擊「確定」，現在所有附件都已重新命名為相同的名稱，如果有重複的附件，則重複的附件將添加數字作為後綴。

在 Outlook 中答覆訊息並保留原始附件

眾所周知，當您在 Outlook 中答覆訊息給收件人時，原始訊息中的附件將被刪除。如果您希望在答覆訊息時保留附件，可以嘗試使用 Kutools for Outlook 的「答覆並帶有附件」功能，該功能可以在答覆單個訊息時保留原始附件，並且適用於所有訊息。 點擊此處查看完整功能 30 天免費試用！