Save / Extract Outlook Attachments from emails and save them to a Folder

I have been meaning to post this for a while.
Some VBA code to extract attachments from a folder in Outlook and save them.

You can choose the Outlook folder but it is hard coded to save the attachments to C:\Email Attachments\
Sub AttachDetach()
‘ *******************************************************************************
‘ Name – AttachDetach
‘ Description – Removes Attachements from an Outlook Folder and saves them to C:\Email Attachments\
‘ Date Changed – 10/03/2011 <– Please keep this up to date
‘ Changed by – Dan Thomas  <– Please keep this up to date
‘ *******************************************************************************

Dim ns As NameSpace

Dim Inbox As MAPIFolder

Dim item As Object

Dim Atmt As attachment

Dim filename As String

Dim i As Integer

Set ns = GetNamespace(“MAPI”)

Set Inbox = ns.PickFolder

i = 0

If Inbox.Items.Count = 0 Then

MsgBox “There are no messages in the Inbox.”, vbInformation, _

“Nothing Found”

Exit Sub

End If

For Each item In Inbox.Items

For Each Atmt In item.Attachments

filename = “C:\Email Attachments\” & i & Atmt.filename

Atmt.SaveAsFile filename

i = i + 1

Next Atmt

Next item

If i > 0 Then

MsgBox “I found ” & i & ” attached files.” _

& vbCrLf & “I have saved them into the C:\Email Attachments folder.” _

& vbCrLf & vbCrLf & “Have a nice day.”, vbInformation, “Finished!”

Else

MsgBox “I didn’t find any attached files in your mail.”, vbInformation, _

“Finished!”

End If

GetAttachments_exit:

Set Atmt = Nothing

Set item = Nothing

Set ns = Nothing

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *