How to rename and save attachments of the email in a folder in Outlook?

In outlook, you may receive messages with attachments usually, and do you try to rename the attachments of the message and save them in a folder as below screenshot shown? Obviously, you can save them into a folder and rename them one by one, but actually, I have a VBA code can quickly rename all attachments with same name then save in one folder.

Rename and save attachments with same name in a folder

Rename and save attachments in a folder with Kutools for Outlook

---

Reply message with original attachments in outlook

As we all known, the attached attachments will be removed from the original message when you replying a message to the recipient in Outlook. If you want to reply massage with keeping attachments, you can try Kutools for Outlook's Reply with Attachment function, it can reply one message with the original attachments, also work for all messafe.    Click for full features 60 days free trial!

Kutools for Outlook: with dozens of handy Outlook add-ins, free to try with no limitation in 60 days.

Rename and save attachments with same name in a folder

1. Select the message which you want to save its attachments and rename to the same name.

2. Press Alt + F11 keys, then in the Project1 pane, double click ThisOutlookSession to create a new blank script in right section, then copy and paste the code to it.

VBA: Rename and save attachments

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

3. Click Tools > References, in the popping dialog, check Microsoft Script Runtime checkbox.

4. Click OK, press F5 key to run the code, a Browse For Folder dialog pops out for selecting or creating a folder to place attachments.

5. Click OK, then give a name for the attachments.

6. Click OK, now the attachments are renamed with same name, if there are duplicates, the duplicate ones will be added numbers as the suffix.

Rename and save attachments in a folder with Kutools for Outlook

Actually, there is a feature in Kutools for Outlook -- a handy addin tool of Outlook can rename all attachments before saving or sending.

Free install Kutools for Outlook, and then do as below steps:

1. Activate the email in nagative pane or in the Message box as you like, click Kutools > Attachment Tools > Rename All.

2. In the popping dialog, type the new name you use for each attachment. Click OK, the attachments have been renamed with new names.
 

3.  Right click at one attachment, select Save All Attachments, click OK and select a folder to save the attachments as you need. Then the renamed attachments have been saved in a folder.