Saving Attachments in Outlook

I spent my new years day recovering from a nasty cold. My wife asked me if there was a way to save the attachments in Microsoft Outlook for multiple messages. I spent a little time and came up with a handy macro, I thought others might find it useful as well.

First, in Outlook click on Tools, Macro, Visual Basic Editor. Now in the editor on the left you’ll see Project. Drill down Project1, Microsoft Office Outlook, ThisOutlookSession, and paste the code below in:

Public Sub SaveAttachments()

‘Note, this assumes you are in the a folder with e-mail messages when you run it.
‘It does not have to be the inbox, simply any folder with e-mail messages

Dim App As New Outlook.Application
Dim Exp As Outlook.Explorer
Dim Sel As Outlook.Selection

Dim AttachmentCnt As Integer
Dim AttTotal As Integer
Dim MsgTotal As Integer

Set Exp = App.ActiveExplorer
Set Sel = Exp.Selection

‘Loop thru each selected item in the inbox
For cnt = 1 To Sel.Count

‘If the e-mail has attachments…
If Sel.Item(cnt).Attachments.Count > 0 Then

MsgTotal = MsgTotal + 1
AttTotal = AttTotal + Sel.Item(cnt).Attachments.Count
‘For each attachment on the message…
For AttachmentCnt = 1 To Sel.Item(cnt).Attachments.Count

‘Get the attachment
Dim att As Attachment
Set att = Sel.Item(cnt).Attachments.Item(AttachmentCnt)
‘Save it to disk
att.SaveAsFile (“C:\Attachments\” + att.FileName)

Next

End If

Next

‘Clean up
Set Sel = Nothing
Set Exp = Nothing
Set App = Nothing

‘Let user know we are done
Dim doneMsg As String
doneMsg = “Completed saving ” + Format$(AttTotal, “#,0″) _
+ ” attachments in ” + Format$(MsgTotal, “#,0″) + ” Messages.”
MsgBox doneMsg, vbOKOnly, “Save Attachments”

Exit Sub

ErrorHandler:

Dim errMsg As String
errMsg = “An error has occurred. Error ” + Err.Number + ” ” _
+ Err.Description

Dim errResult As VbMsgBoxResult
errResult = MsgBox(errMsg, vbAbortRetryIgnore, _
“Error in Save Attachments”)
Select Case errResult

Case vbAbort

Exit Sub

Case vbRetry

Resume

Case vbIgnore

Resume Next

End Select

End Sub

Note some browsers trash the html I tried to do above, so I uploaded it as a text file. Just save to your hard drive and paste into the VBScript Editor or rename the txt to cls and do a File, Import and browse to this file: https://arcanecode.files.wordpress.com/2007/01/saveattachments1.txt

And of course save it. Now switch back to Outlook, and click on View, Toolbars, Customize. Click on the Toolbars tab, and click New. I named my new toolbar ArcaneCode, but name yours what you will.

Once you have the new toolbar, click on the Commands tab. Scroll down on the left to Macros and click on it. You should see your new macro in the Commands window on the left. Drag it on to your new toolbar. Now you can shorten the name a little, right click on the tool, to see it’s pop up menu. Go to Name and click on it, then shorten the name to what you want. I then drug my new toolbar up with the rest of my other toolbars.

Two notes, I made it easy on myself and am saving all attachments to C:\Attachments, which I’ve hardcoded in the macro. Feel free to change to what you want or add code to have it ask you for the folder.

Second, I have tested with Outlook 2002 and 2003, but have not tested under 2007. Your milage may vary.

And there you go, a way to save attachments on all the messages you have selected within Outlook.

Advertisements