Saving Attachments in Outlook « Arcane Code
Note: de code is ook beschikbaar via saveattachments1.
January 2, 2007 — arcanecode
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 messagesDim App As New Outlook.Application
Dim Exp As Outlook.Explorer
Dim Sel As Outlook.SelectionDim AttachmentCnt As Integer
Dim AttTotal As Integer
Dim MsgTotal As IntegerSet 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 SubCase vbRetry
ResumeCase vbIgnore
Resume NextEnd 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: http://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.
Een onderzoekje doen lijkt heel makkelijk; een lijstje vragen kan iedereen opstellen, uitsturen en klaar! Gelukkig weten de meesten onder jullie wel dat een lijstje vragen iets anders is als een goede vragenlijst, dus daar zal ik verder niet op in gaan. Ook het uitsturen is niet iets dat je lukraak doet; een goede steekproef is (meestal) noodzakelijk. Al de basis beginselen zijn wel bekend, toch? Dat dit niet altijd het geval is blijkt wel uit allerhande twijfelachtige berichtjes over onderzoeksresultaten die her en der opduiken of misschien heb je zelf weleens een enquête ingevuld waarbij je haren overeind gingen staan bij het soort vragen dat je kreeg.