Saving All Attachments in Outlook

Back on January 3’rd, 2007 (http://arcanecode.wordpress.com/2007/01/03/enhancing-the-save-attachments-outlook-macro/ or http://shrinkster.com/mhm) I posted a useful macro that would save attachments on the selected items in a folder. Since then several have written asking for a version that would save all attachments for every item in a folder, whether it was selected or not.

UPDATE: Some users were having problems downloading the code, so I’ve posted it at: http://arcanecode.com/2011/07/16/revisting-the-outlook-save-all-attachments-macro/

I finally had a chance to experiment, and it turned out to be very easy. To create a version that saves attachments for all items, you only have to change three lines of code.

The first line is the name of the sub. I changed

Public Sub SaveAttachments()

To

Public Sub SaveAllAttachments()

Easy enough. Next, the variable declaration of

Dim Sel As Outlook.Selection

Has to be changed to

Dim Sel As Outlook.Items

The final change is to

Set Sel = Exp.Selection

It becomes

Set Sel = Exp.CurrentFolder.Items

And that’s it, it works. Let me explain what’s happening. In the original, I was cycling through the Selection collection of the Outlook Explorer object. The Selection is a special type of Items collection that holds what’s selected.

For our new macro we wanted all of the items in the current folder, not just what was selected. The first thing we had to do, after changing the sub’s name, was to change the data type of the Sel variable. I wanted to get away from the specific selection collection to the more generic items collection.

Then, all I had to do was have the Sel point to the Items collection of the current folder. Since both Selection and CurrentFolder.Items both support the Items interface, everything else just worked. That’s the power of OOP!

I’ve uploaded a new version of the file as Save All Attachments. It contains this version, the original SaveAttachements, and the GetOutputDirectory function. If you are installing this new, please don’t forget to set a reference to the Microsoft Scripting Runtime Library (scrrun.dll).

Select Tool, References from the VB Macros Editor. Scroll down until you find Microsoft Scripting Runtime, and check it. You’ll know it’s the right one when the file name is scrrun.dll.

[VB References Dialog]

I’ve tested this with messages stored in a variety of folders, including the Inbox. It’s based off the current folder, so it doesn’t seem to care where you are at. I’ve also gotten this to work with the calendar as well.

There you go, you now have a choice. Using my original macro you can save attachments for only the selected items in the current folder, or using this version you can save all attachments for all items in the current folder. I hope the folks who requested the change will find this fits their needs, enjoy!

 

Outlook and “Macros are Disabled” error

One error some people seem to be getting when trying to run macros in Outlook is: “The macros for this project have been disabled.” It then goes on to tell you to review some help that isn’t very helpful.

The scenario is generally the same, you create your macro and it runs fine, you close Outlook and when you re-enter the macros no longer run. Some blogs suggested lowering your security settings, or signing the thing, but I tried both of these to no avail.  

The only way I was able to solve the problem was to follow these steps:

  1. Copy EVERYTHING out of your VB macro project, into a text file. Save the textfile to your drive. 
  2. Close everything, reboot the computer.
  3. Go to your C:\Documents and settings\<yourusernamehere>\Application Data\Microsoft\Outlook folder.
  4. Either delete the file VBAProject.otm, or (better and safer) rename to VBAProject.old or some similar name.
  5. Open Outlook
  6. Reopen the VB Macro editor
  7. Paste in the code from your text file.

After doing the above, I was able to start running the SaveAttachements macro I blogged about yesterday. From my research, no one is really quite sure why this headache occurs, and why this is the only way to fix it, but it does work. 

Enhancing the Save Attachments Outlook Macro

Update: Feb. 28, 2007: Due to numerous requests I’ve created a branch of this macro that saves attachments for all messages / calendar items, selected or not. To see it, please see my post http://arcanecode.wordpress.com/2007/02/28/saving-all-attachments-in-outlook/ or http://shrinkster.com/mhn. There I have uploaded a new file with both the macro below and the new one that saves all items, selected or not.

Yesterday I blogged about a macro I wrote for my wife to allow her to save attachments for multiple messages in Outlook. After using it today she asked for a few enhancements. First, she wanted to be able to select the directory to save the attachments to. Second, she wanted the macro to detect that a file already existed, and allow her to rename the new file or skip it.

To accomplish the first item, I found a handy routine in a google groups thread. I’ll let you read it for yourself, the code is about half way down in a message by Joe Earnest, and can be found at http://shrinkster.com/l0v. I took Joe’s code and created a function out of it called GetOutputDirectory. I made one enhancement, at the end I make sure the output directory ends in a backslash.

For the second enhancement I used the good old scripting runtime library. Use the Tools, References menu in the VBScript editor and set a reference to the “Microsoft Scripting Runtime”, scrrun.dll. Rather than reposting all the code I’ve put the entire macro in a txt file you can download here: http://arcanecode.files.wordpress.com/2007/01/saveattachments2.txt

Here is the heart of the code

fileExists = fso.fileExists(outputDir + outputFile)

Do While fileExists = True
outputFile = InputBox(“The file ” + outputFile _
+ ” already exists in the destination directory of ” _
+ outputDir + “. Please enter a new name, or hit cancel to skip this one file.”, “File Exists”, outputFile)
‘If user hit cancel
If outputFile = “” Then
‘Exit leaving fileexists true. That will be a flag not to write the file
Exit Do
End If
fileExists = fso.fileExists(outputDir + outputFile)
Loop

‘Save it to disk
If fileExists = False Then
att.SaveAsFile (outputDir + outputFile)
AttTotal = AttTotal + 1
End If

As you can see, I check to see if the file exists and store that in a variable. I then enter a loop if the file exists, ask for a new name, then check to see if the new name exists. I stay in the loop as long as it does.

Should the user click the cancel button on the input box, I exit the loop prematurely and use the fileexists as a flag to write or not write the file.

There you go, an enhanced version of the SaveAttachments macro. Take a look at the full file I’ve uploaded, and leave a comment with any questions.

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: 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.

Follow

Get every new post delivered to your Inbox.

Join 106 other followers