How to save all attachments from multiple emails to folder in Outlook?

It is easy to save all attachments from an email with the build-in Save All Attachments feature in Outlook. However, if you want to save all attachments from multiple emails at once, there is no direct feature can help. You need to repeatedly apply the Save All Attachments feature in each email until all attachments are saved from those emails. That’s time-consuming. In this article, we introduce two methods for you to bulk save all attachments from multiple emails to a specific folder easily in Outlook.

Save all attachments from multiple emails to folder with VBA code
Several clicks to save all attachments from multiple emails to folder with an amazing tool

Save all attachments from multiple emails to folder with VBA code

This section demonstrates a VBA code in a step-by-step guide to help you quickly save all attachments from multiple emails to a specific folder at once. Please do as follows.

1. Firstly, you need to create a folder for saving the attachments in your computer.

Get into the Documents folder and create a folder named “Attachments”. See screenshot:

2. Select the emails which the attachments you will save, and then press Alt + F11 keys to open the Microsoft Visual Basic for Applications window.

3. Click Insert > Module to open the Module window, and then copy one of the following VBA code into the window.

VBA code 1: Bulk save attachments from multiple emails (save exact same name attachments directly)

Tips: This code will save exact same name attachments by adding digits 1, 2, 3...after file names.

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 code 2: Bulk save attachments from multiple emails (check for duplicates)

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

Notes:

5. Press the F5 key to run the code.

Then all attachments in selected emails are saved to the folder you created in step 1. 

Notes: There may be a Microsoft Outlook prompt box popping up, please click the Allow button to go ahead.

Save all attachments from multiple emails to folder with an amazing tool

If you are a newbie in VBA, here highly recommended the Save All attachments utility of Kutools for Outook for you. With this utility, you can quickly save all attachments from multiple emails at once with several clicks only in Outlook.
Before applying the feature, please download and install Kutools for Outlook firstly.

1. Select the emails containing the attachments you want to save.

Tips: You can select multiple nonadjacent emails by holding the Ctrl key and select them one by one;
Or select multiple adjacent emails by holding the Shift key and select the first email and the last one.

2. Click Kutools >Attachment Tools > Save All. See screenshot:

3. In the Save Settings dialog, click the button to select a folder to save the attachments, and then click the OK button.

3. Click OK twice in the next popping up to dialog box, Then all attachments in selected emails are saved in specified folder at once.

Notes:

• 1. If you want to save attachments in different folders based on emails, please check the Create subfolders in the following style box, and choose a folder style from the drop-down.
• 2. Besides save all attachments, you can save attachments by specific conditions. For example, you only want to save the pdf file attachments which the file name contains the word "Invoice", please click the Advanced options button to expand the conditions, and then configure as the below screebshot shown.
  
• 3. If you want to automatically save attachments when email arriving, the Auto Save attachments feature can help.
• 4. For detaching the attachments directly from selected emails, the Detach All attachments feature of Kutools for Outlook can do you a favor.

Related articles