Excel VBA get File Attached to Outlook Email

Save Outlook Attachment from 1 email

This VBA will connect to an Outlook folder and save the attachment to a folder.

*Update ipath to filepath where you want to save the attachment to

*Update .Item(“BoxName”).Folders(“Inbox”) with your Outlook Folders name.

*Update .Items(1) to be the email number of the email your trying to grab

Dim myAttachments As Outlook.Attachments
 
Set myOlApp = CreateObject("Outlook.Application")
Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNamespace.Folders.Item("BoxName").Folders("Inbox")
'myFolder.Display

Set myItem = myFolder.Items(1)
myItem.Display

Set myAttachments = myItem.Attachments
ipath = "Z:\Dylan\"
myAttachments.Item(1).SaveAsFile ipath & myAttachments.Item(1).DisplayName

MsgBox myAttachments.Item(1).DisplayName & " has been saved to " & ipath

 

Save All Outlook Email Attachments from Folder

If you want to save the attachments of all emails in the folder then just add a for loop replacing items(1) with items(i).

Dim myAttachments As Outlook.Attachments
 
Set myOlApp = CreateObject("Outlook.Application")
Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNamespace.Folders.Item("BoxName").Folders("Inbox")
'myFolder.Display

itemsCount = myFolder.Items.Count
i = 0
For i = 1 To itemsCount

Set myItem = myFolder.Items(i)
myItem.Display

Set myAttachments = myItem.Attachments
If myItem.Attachments.Count > 0 Then
 ipath = "Z:\Dylan\attachments\"
 On Error Resume Next
 myAttachments.Item(i).SaveAsFile ipath & myAttachments.Item(i).DisplayName
 ' MsgBox myAttachments.Item(i).DisplayName & " has been saved to " & ipath
 On Error GoTo 0
End If

Interested in learning new skills?