Download Attachments From Outlook Emails

Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.

Each code block covered in the video is given below.

In this post, we are going to look at how to extract attachments from Outlook emails. We will look at 2 ways of achieving this. First way, is by connecting directly to Outlook. And the second way, would be to manually copy the emails onto a local folder on our computer, and then run our code over those saved emails. Both achieve the same result.

Connect Directly To Outlook

Option Explicit
Public Const sOutFolder As String = "C:\Youtube\Current\05 Extract Emails\Demo\Output"
Sub ReadOutlookEmailsv1()

Dim oApp As Object
Dim oName As Object
Dim oFolder As Object
Set oApp = CreateObject("Outlook.Application")
Set oName = oApp.GetNamespace("MAPI")
Set oFolder = oName.GetDefaultFolder(6).Folders("Invoices")
'To access Inbox directly, use the below code.
'Set oFolder = oName.GetDefaultFolder(6)
Dim oMail As Object
Dim oAttach As Object
Dim sAttachName As String

For Each oMail In oFolder.Items
    For Each oAttach In oMail.Attachments
        sAttachName = oAttach.Filename
        sAttachName = sOutFolder & "\" & sAttachName
        oAttach.SaveAsFile sAttachName
    Next oAttach
Next oMail
End Sub

Extract from Saved Messages

Option Explicit
Public Const sInFolder As String = "C:\Youtube\Current\05 Extract Emails\Demo\Input"
Public Const sOutFolder As String = "C:\Youtube\Current\05 Extract Emails\Demo\Output"

Sub ReadOutlookEmailsv2()

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldrOutlookIn As Object
Set fldrOutlookIn = fso.GetFolder(sInFolder)

Dim oApp As Object
Set oApp = CreateObject("Outlook.Application")
Dim oMail As Object
Dim oAttach As Object
Dim fileItem As Object
Dim sAttachName As String

For Each fileItem In fldrOutlookIn.Files
    Set oMail = oApp.CreateItemFromTemplate(fileItem.Path)
    For Each oAttach In oMail.Attachments
        sAttachName = oAttach.Filename
        sAttachName = sOutFolder & "\" & sAttachName
        oAttach.SaveAsFile sAttachName
    Next oAttach
    Set oMail = Nothing
Next fileItem

End Sub

Code to Output Details of Email and Save Attachments

This relates to the macro for extracting attachments from saved Email messages. I have added code to output details from the email such as Sender Name, Received Time and Number of Attachments onto the worksheet (code name: Sheet1)

Option Explicit

Public Const sInFolder As String = "C:\Youtube\Archive\2023\Dec 23\05 Extract Emails\Demo\Input"
Public Const sOutFolder As String = "C:\Youtube\Archive\2023\Dec 23\05 Extract Emails\Demo\Output"

Sub ReadOutlookEmailsv3()

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldrOutlookIn As Object
Set fldrOutlookIn = fso.GetFolder(sInFolder)

Dim oApp As Object
Set oApp = CreateObject("Outlook.Application")
Dim oMail As Object
Dim oAttach As Object
Dim fileItem As Object
Dim sAttachName As String

' Code to Output Email Details
' Start
Sheet1.Cells.Clear
Sheet1.Range("A1").Value = "Email Sender Name"
Sheet1.Range("B1").Value = "Received Time"
Sheet1.Range("C1").Value = "No. Of Attachments"
Dim i As Long, attachCounter As Long
i = 1
' End

For Each fileItem In fldrOutlookIn.Files
    Set oMail = oApp.CreateItemFromTemplate(fileItem.Path)
    ' Code to Output Email Details
    ' Start
    i = i + 1
    Sheet1.Range("A" & i).Value = oMail.SenderEmailAddress
    Sheet1.Range("B" & i).Value = oMail.ReceivedTime
    attachCounter = 0
    ' End
    For Each oAttach In oMail.Attachments
        ' Code to Count Attachments
        ' Start
        attachCounter = attachCounter + 1
        ' End
        sAttachName = oAttach.Filename
        sAttachName = sOutFolder & "\" & sAttachName
        oAttach.SaveAsFile sAttachName
    Next oAttach
    ' Code to Output Attachment Counter
    ' Start
    Sheet1.Range("C" & i).Value = attachCounter
    ' End
    Set oMail = Nothing
Next fileItem

End Sub

Related Posts