Revisting the Outlook Save All Attachments Macro

Back in 2007 I created a post on an Outlook Macro to save all attachments for an e-mail. Some people were having a problem downloading the file (not sure why as it worked for me) but to help out thought I’d repost the code in full.

Note I have not tried this with Outlook 2010, so use at your own risk.


Option Explicit


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
  
  Dim outputDir As String
  Dim outputFile As String
  Dim fileExists As Boolean
  Dim cnt As Integer
  
  'Requires reference to Microsoft Scripting Runtime (SCRRUN.DLL)
  Dim fso As FileSystemObject
    
  Set Exp = App.ActiveExplorer
  Set Sel = Exp.Selection
  Set fso = New FileSystemObject

  outputDir = GetOutputDirectory()
  If outputDir = "" Then
    MsgBox "You must pick an directory to save your files to. Exiting SaveAttachments.", vbCritical, "SaveAttachments"
    Exit Sub
  End If
    
  '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
      '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)
        outputFile = att.fileName
        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 the file does not exist
        If fileExists = False Then
          att.SaveAsFile (outputDir + outputFile)
          AttTotal = AttTotal + 1
        End If
      Next
    End If
  Next
  
  'Clean up
  Set Sel = Nothing
  Set Exp = Nothing
  Set App = Nothing
  Set fso = 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

'Found this code in a google groups thread here:
'http://groups.google.com/group/microsoft.public.scripting.vbscript/browse_thread/thread/7187886c3c83a570/c278a2753e9e7ceb%23c278a2753e9e7ceb
'or http://shrinkster.com/l0v
Public Function GetOutputDirectory() As String
 
  Dim retval As String 'Return Value
  
  Dim sMsg As String
  Dim cBits As Integer
  Dim xRoot As Integer
  
  Dim oShell As Object
  Set oShell = CreateObject("shell.application")

  sMsg = "Select a Folder To Output The Attachments To"
  cBits = 1
  xRoot = 17
  
  On Error Resume Next
      Dim oBFF
      Set oBFF = oShell.BrowseForFolder(0, sMsg, cBits, xRoot)
      If Err Then
        Err.Clear
        GetOutputDirectory = ""
        Exit Function
      End If
  On Error GoTo 0
  
  If Not IsObject(oBFF) Then
    GetOutputDirectory = ""
    Exit Function
  End If
  
  If Not (LCase(Left(Trim(TypeName(oBFF)), 6)) = "folder") Then
    retval = ""
  Else
    retval = oBFF.self.Path
    
    'Make sure there's a \ on the end
    If Right(retval, 1) <> "\" Then
      retval = retval + "\"
    End If
  End If
  
  GetOutputDirectory = retval
  
End Function


Taming the Outlook E-Mail Monster

Over time I’ve read quite a few helpful hints and tips on how to “tame” your e-mail. I have a few I’ve developed over time that I haven’t seen mentioned before, so I thought I’d share.

First, I deal with a lot of different projects at once. One thing I find valuable is to include the name of the project the e-mail is about in the subject line. That helps me later, to quickly categorize my mails. At the very least, make sure to include the project name somewhere in the body of the mail. Nothing’s more confusing then getting cc’d on an e-mail that says “I took care of the files” and not knowing what project the person refers to.

Next comes archiving of your e-mails. Many texts I’ve read tell you to read the e-mail, take action on it, then get it out of your inbox. But what do you do with it when you’re done for the time, but you may want to save it to refer back to later?

I’ve found the best method is to create individual Outlook data files (.pst) files for each project. True, you will wind up with a lot of pst files, but you can easily close them once the project is complete and get them out of your way. You can even burn them to a CD or DVD when you need more disk space yet still be able to open them.

You still have the luxury of creating individual folders within the projects pst file, if you need to subdivide more; perhaps meeting minutes, agendas, coding, and testing might be folders you want.

At one time I just had one projects folder with folders and subfolders galore. The problem was it quickly became cluttered from past projects, and kept growing in size. I found moving each project to its own data file to be much easier to manage.

OK, I hear you asking “What about those e-mails not associated with projects?” Maybe it’s a policy notice, or a confirmation about a software purchase, or just some “congrats you did a good job” e-mail you’d like to hang on to. For those I create an Outlook data file for each year. I then have 12 folders, one for each month.

I am very strict with myself about what goes in here, to keep it from becoming a miscellaneous junk bin. I typically have no more than 20 or 25 messages for any given month worthy of hanging on to.

OK, we’ve all been victims of this next situation. We go off to a two hour meeting, come back, and find thirty seconds after we walked away someone sent out an e-mail and copied the entire department. Half the folks chose to respond, then the other half replied to the response, and before you know it there’s 42 unread mails on the one subject alone, not to mention all the other mail that’s come in. How do you quickly isolate those e-mails for a given project and deal with them?

For that I find Outlook’s Find tool invaluable. In Outlook 2003, select Tools, Find, Find from the menu:

taming01

You should then see a new tool area just above your inbox:

taming02

In Outlook 2007, the Find feature is turned on and built into the Inbox bar by default:

taming03

In either case, simply type in what you want, like the name of your project (remember my first tip?) and hit enter, or click the word Search (2003) or the magnifying glass (2007). The area where your inbox sits will now show only the messages with your search word in either the subject or the message body.

Once you have filtered your box to show only those messages you want, it becomes an easy matter to move them to archive, delete them, or deal with them in some other manner.

When done, simply click Clear (2003) or the X (it pops up where the magnifying glass is in 2007) and your inbox will be returned to it’s non-filtered state, hopefully with a few less messages for you to deal with.

OK, so you have a piece of mail that you want to keep in your inbox for a few days, you don’t want to file it quite yet, but don’t have to handle it right this second. Most common for me are announcements that a database or system will be offline for maintenance. I certainly want to know about it, and be reminded, but don’t need to do anything right now. For this I use the flags.

The very right most column of your inbox depicts a small flag. Clicking on it will turn the flag to a red color. In 2003, you can pick different colors, in 2007 the color is tied to the distance in the future the event will occur.

taming04

In either version, one of the menu options is “Add Reminder”. With it, a dialog pops up to let you give a calendar date / time when you need to take action.

taming05

In this example, the e-mail was letting me know of a live radio interview being done with a member of one of my favorite bands, Midnight Syndicate (http://www.midnightsyndicate.com). I’m adding a reminder to that e-mail so I’ll be sure not to miss it.

I’ll then basically ignore the message, letting it sit in my inbox until the time comes for me to deal with it. Once the event is complete, be it a database outage, meeting, or special event, I can click again on the flag, to “Mark as complete”. I can choose to archive the message, respond to it, or delete it.

Speaking of deleting, the final piece of advice I can offer is delete, delete, delete. Let’s face it, how many of those messages do you really need? If you are the recipient of a long chain of e-mails, just keep the last one and delete the rest, their contents duplicated in the last one.

Meeting announcements, bake sales, grocery lists from the spouse, are all things which hit the bit bucket as soon as I’m done with them. I’d bet if you’re like me, a good percentage of your e-mail can safely be deleted.

Using these techniques, I’m able to keep my inbox to between 100 and 150 messages, a manageable level. A fry cry from the old days where I might have 2,500 messages in my inbox!

I’m always trying to improve, though, so if you have ideas for taming your inbox please post a comment and share with the community.

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 102 other followers