Save All Attachments from Outlook into Folder VBA

The below code counts the number of emails in your Outlook folder Inbox, selects each email one by one, and then saves down all attachments into a folder. This method of saving files down is useful when you consider the fact that you can have Outlook run events that execute when you receive a new email. You can essentially set your Outlook up to auto-save down files and execute other Excel macros without even needing to do anything.

If you are unsure of where to paste this code, I recommend followings steps 1-7 here or watching the video on this page: How to Enable Developer Tab in Outlook.

---

Sub SaveAttachmentsFromSelectedMailItems()
Dim individualItem As Object
Dim att As Attachment
Dim strPath As String
Dim dicFileNames As Object

' counts the amount of emails
Dim O As Double
For N = 1 To Application.GetNamespace("MAPI") _        
.GetDefaultFolder(olFolderInbox) _
.Items.Count
   
Next N


Dim I As Integer
I = 1

'Loop through Inbox and select each email item
  Do Until I = N
ActiveExplorer.AddToSelection _ 
Application.GetNamespace("MAPI") _
.GetDefaultFolder(olFolderInbox) _
    .Items(I)
I = I + 1
Loop

'set the path for where the attachments will be saved
    strPath = "C:\Users\Nonaluuluu\Documents\Attachments\"
    
    Set dicFileNames = CreateObject("Scripting.Dictionary")
    
    For Each individualItem In Application.ActiveExplorer.Selection
        If TypeName(individualItem) = "MailItem" Then
            For Each att In individualItem.Attachments
                If Not dicFileNames.exists(att.FileName) Then
                dicFileNames.Add att.FileName, 1
                Else
                dicFileNames(att.FileName) = dicFileNames(att.FileName) + 1
                End If
                
                att.SaveAsFile strPath & att.FileName
            Next att
        End If
    Next individualItem
    
End Sub

---