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
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
If xSaveFiles <> "" Then
If xMailItem.BodyFormat <> olFormatHTML Then
xMailItem.Body = vbCrLf & "The file(s) were saved to " & xSaveFiles & vbCrLf & xMailItem.Body
Else
xMailItem.HTMLBody = "<p>" & "The file(s) were saved to " & xSaveFiles & "</p>" & xMailItem.HTMLBody
End If
End If
xMailItem.Save
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
If xSaveFiles <> "" Then
If xMailItem.BodyFormat <> olFormatHTML Then
xMailItem.Body = vbCrLf & "The file(s) were saved to " & xSaveFiles & vbCrLf & xMailItem.Body
Else
xMailItem.HTMLBody = "<p>" & "The file(s) were saved to " & xSaveFiles & "</p>" & xMailItem.HTMLBody
End If
End If
xMailItem.Save
End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub
Notes:
1) If you want to save all same name attachments in a folder, please apply the above VBA code 1. Before running this code, please click Tools > References, and then check the Microsoft Scripting Runtime box in the References - Project dialog box;
2) If you want to check for duplicate attachment names, please apply the VBA code 2. After running the code, a dialog will pop up to remind you whether to replace the duplicate attachments, choose Yes or No based on your needs.
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. You will see there are hyperlinks displayed in selected emails. Click on the link will open the specific attachment automatically.
Note: 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.
If you want to have a free trial ( 60-day) of this utility, please click to download it, and then go to apply the operation according above steps.
Related articles
Insert attachments in the body of email message in Outlook Normally attachments are displayed in the Attached field in a composing email. Here this tutorial provides methods to help you easily insert attachments in the email body in Outlook.
Automatically download/save attachments from Outlook to a certain folder Generally speaking, you can save all attachments of one email with clicking Attachments > Save All Attachments in Outlook. But, if you need to save all attachments from all received emails and receiving emails, any ideal? This article will introduce two solutions to automatically download attachments from Outlook to a certain folder.
Print all attachments in one/multiple emails in Outlook As you know, it will only print the email content such as header, body when you click the File > Print in Microsoft Outlook, but not print the attachments. Here we will show you how to print all attachments in a selected email at ease in Microsoft Outlook.
Search words within attachment (content) in Outlook When we typing a keyword in the Instant Search box in Outlook, it will search the keyword in emails’ subjects, bodies, attachments, etc. But now I just need to search the keyword in attachment content only in Outlook, any idea? This article shows you the detailed steps to search words within attachment content in Outlook easily.
Keep attachments when replying in Outlook When we forward an email message in Microsoft Outlook, original attachments in this email message are remained in the forwarded message. However, when we reply an email message, the original attachments will not be attached in the new reply message. Here we are going to introduce a couple of tricks about keeping original attachments when replying in Microsoft Outlook.
Auto CC/BCC by rules when sending email; Auto Forward Multiple Emails by custom; Auto Reply without exchange server, and more automatic features...
BCC Warning - show message when you try to reply all if your mail address is in the BCC list; Remind When Missing Attachments, and more remind features...
Reply (All) With All Attachments in the mail conversation; Reply Many Emails in seconds; Auto Add Greeting when reply; Add Date into subject...
Attachment Tools: Manage All Attachments in All Mails, Auto Detach, Compress All, Rename All, Save All... Quick Report, Count Selected Mails...
Powerful Junk Emails by custom; Remove Duplicate Mails and Contacts... Enable you to do smarter, faster and better in Outlook.
Thank you, but only works if the attachments each have different names. For same name attachments, it will just overwrite the previous file. So I edited this VBA script to prefix each file saved with a number:
Public Sub SaveAttachments()
'Update 20191101 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\"
Dim i2 As Long i2 = 0
For Each objMsg In objSelection i2 = i2 + 1
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 & CStr(i2) & "_" & strFile objAttachments.Item(i).SaveAsFile strFile
'objAttachments.Item(i).Delete() If objMsg.BodyFormat <> olFormatHTML Then
strDeletedFiles = strDeletedFiles & vbCrLf & "!>
Works great! if files have different namnes, as stated in earlier comment, I know my files will have same name, can you adjust the code anyway so that it works with same name files? Maybe adding time stamp to the file name? or just digits 1, 2, 3 etc (But not digits after filetype code, eg. ".csv 1"...) Thanks alot!!
Is it possible to name the files based off the subject line. You know how you can edit the subject line from received emails i organize my emails by customer name and date. Can I have the script use the subject line as the file name?
Hi Alan, The code I replied to you before has some problems. I have added new codes to the tutorial, and the problem you mentioned have been solved. Please have a look and try it. Thank you!
So I click the link "Kutools for outlook" and I'm directed to a page that is not that, but "Kutools - Combines More Than 300 Advanced Functions and Tools for Microsoft Excel."
This is what the code is at now, and it does save all the attachments, but it only adds text to the first message. Can anyone help me with this?
Public Sub SaveAttachments() 'Update 20170523 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 Set objOL = CreateObject("Outlook.Application") Set objSelection = objOL.ActiveExplorer.Selection strFolderpath = "C:\Users\brianp\Documents\Attachments\" For Each objMsg In objSelection Set objAttachments = objMsg.Attachments lngCount = objAttachments.Count 'Use this to test MsgBox "Subject = " & objMsg.Subject & " lngCount = " & objAttachments.Count If lngCount > 0 Then For I = lngCount To 1 Step -1 strFile = objAttachments.Item(I).FileName strFile = strFolderpath & strFile objAttachments.Item(I).SaveAsFile strFile Next I End If If objMsg.BodyFormat olFormatHTML Then objMsg.Body = vbCrLf & "The Attached file(s) were saved to " & "" & strFile & "" & vbCrLf & objMsg.Body Else objMsg.HTMLBody = "" & "The Attached file(s) were saved to " & "" & strFile & "" & "" & objMsg.HTMLBody End If Next ExitSub: Set objAttachments = Nothing Set objMsg = Nothing Set objSelection = Nothing Set objOL = Nothing End Sub
This worked great except for one problem. The attachments in my emails are all named the same thing, so when they copy over, the script keeps replacing the same file with the next attachment in the queue. Is there any way to make it rename them rather than rewrite them?
Hi..I tried everything on here but I keep getting Complile Error block if without end if. I made adjustments per Thomas' suggestions. Heres the code..what am I missing? Any help is appreciated. Public Sub SaveAttachments() 'Update 20130828 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 objOL = CreateObject("Outlook.Application") objSelection = objOL.ActiveExplorer.Selection strFolderpath = "C:\folder\Attachments\" For Each objMsg In objSelection 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 DoEvents 'objAttachments.Item(i).Delete() Next ExitSub: objAttachments = Nothing objMsg = Nothing Set objSelection = objOL.ActiveExplorer.Selection objOL = Nothing End Sub
Following on the suggestions above, I had daily system generated emails with attached 'report.txt' and needed to append the sent date to the saved file name in order to avoid overwrites and to distinguish files. Made the following adds in the appropriate places: add- Dim strSent As String add- strSent = Format(objMsg.SentOn, "yymmdd") add- strFile = strSent & strFile
I agree with Stephan on his first two points, see some clarification on his point 3. Finally, adding a DoEvents at the right place should allow you to process large number of emails (just run this code on 157 mails in Outlook 2013).
Some additional thoughts:
1) This works only if you use the Documents folder. For a more general case: delete line 12 line 15 should read: strFolderpath = "C:\folder\otherfolder\"
substitute [i]C:\folder\otherfolder\[/i] with whatever path you have.
2) This code will not delete the attachments, if you want that just delete the leading ' from line 25.
3) If you have big attachments, then probably it is a good idea (as Stephan noted) to put a DoEvents function after line 24.
4) I personally do not want to modify the emails in any way (e.g. adding the file save path to the text of the mail), if you agree with me then you can delete line 26-39.
5) If you skip my step 4, then you can allow the program to modify the emails by checking "Allow access for x time", then you have to click allow only once (c.f. step 6 above in the original).
button to select a folder to save the attachments, and then click the OK button.
