Do you wish there was a magic bullet to control your Outlook inbox? There are all kinds of management theories like GTD (Getting things done), FIFO (First In First Out), Least Effort, Inbox Zero, etc. While these are all effective management techniques if implemented correctly, the problem is that the reality is different than theory.
Personally, I *try* to practice Inbox Zero. I get around 500 work email messages daily, not all of which I need to deal with. Many are server notifications, group notifications, company-wide emails, etc. These are easy to filter out with Outlook rules and are sent to different folders that I peruse at my leisure. Beyond that, anything that isn’t addressed to me directly, e.g. sent to me as part of a group, goes to a different folder as well. I also delete all emails that I reply to because I save Sent items and it makes more sense to save the email thread with my reply. At this point, I feel my Inbox is “manageable”. My REAL problem is that it is not deemed manageable by my Outlook system administrators. I am allotted 100MB for my mailbox before I am placed in “email jail”. Beyond that, I can receive emails, but may not be able to send. Don’t ask me how they do this or why, I don’t really care because it happens (seriously though, disk space is the cheapest IT investment you can make).
What I’ve found is that I get lots of attachments from people. Lots and lots and lots of attachments and they aren’t small either. With my kind of limit, it would take only 50 2MB attachments to fill up my space (if only 10% of my daily volume has attachments I’m done. The reality is that I deal with other accountants, and accountants LOVE spreadsheets, especially really, really big ones. It’s not uncommon when a problem arises to see a 20-30MB bad boy flop into my inbox). The irony is that I have 100GB of personal space on our servers. (For those wondering, Outlook is on SAN space and “personal” drives are a NAS mount, so there’s a huge cost difference.) Many people in this situation would go with an aggressive archiving process. The problem with this is that
- Now I have to search the “archive” folders for even recent email (7 days or more for me)
- Storing all those attachments on the mail messages is extremely inefficient
I haven’t done the math, but searching for messages with attachments doesn’t seem to run any faster than an ordinary search. Combine that with the larger my .pst file gets, the slower searches seem to be and I’m motivated to keep my archive as small as possible. To do that, I do not archive attachments. Instead, every couple of days I run a script that will take all the emails in a given folder (one I select) and either save or delete the attachments. When I choose save, it saves the files using the Sender Name and attachment. So if someone says they sent me something, I go to my “Attachments” folder on my personal drive, sort on their name, and find the file name.
So here’s how I do it. I have a VB form defined with the following code in Outlook (this it 2003 tested). The form prompts you for a folder and whether you want to save or delete the attachments. If you pick save, you’re prompted for a file location. After that, the script iterates the messages in the folder and performs the requested action on the attachments. In all cases it removes the attachment from the selected message. If you’re paranoid, it writes plenty of debug statements, so you can always watch it run or you can comment out line 174 below (highlighted).
'Global Variables Dim app As New Outlook.Application Dim ns As Outlook.NameSpace Dim root As Outlook.MAPIFolder Dim strFolder As String Dim objSelFolder As Outlook.MAPIFolder Private Sub cmbFolders_Change() UnIterateSub cmbFolders.Value End Sub Private Sub cmdExecute_Click() If Opt1.Value = True Then Attachments objSelFolder, True Else Attachments objSelFolder, False End If End Sub Private Sub Opt1_Click() strFolder = GetFolder() End Sub Private Sub UserForm_Activate() Set app = CreateObject("Outlook.Application") Set ns = app.GetNamespace("MAPI") LoadFolderList End Sub 'Call List Builder Sub LoadFolderList() Set root = ns.GetDefaultFolder(olFolderInbox).Parent IterateSub root.Folders, 0, "" End Sub 'Build list of folders for current mailbox Sub IterateSub(fgrp As Outlook.Folders, intCounter As Integer, strParent As String) Dim fsub As Outlook.MAPIFolder Dim intLoc As Integer intLoc = 0 Set fsub = fgrp.GetFirst Do While Not fsub Is Nothing strParent = strParent & "\" & fsub.Name Debug.Print fsub.Name, fsub.Folders.Count, intCounter, strParent cmbFolders.AddItem strParent If fsub.Folders.Count > 0 Then intCounter = intCounter + 1 IterateSub fsub.Folders, intCounter, strParent Else If strParent <> "" Then intLoc = InStrRev(strParent, "\") strParent = Left(strParent, intLoc - 1) End If End If Set fsub = fgrp.GetNext Loop If intCounter <> 0 Then intCounter = intCounter - 1 End If If strParent <> "" Then intLoc = InStrRev(strParent, "\") strParent = Left(strParent, intLoc - 1) End If End Sub 'Reset location on change of folder Sub UnIterateSub(strFolderValue As String) Dim x Dim arrFolders As Variant arrFolders = Split(strFolderValue, "\") For x = 1 To UBound(arrFolders) If x = 1 Then Set objSelFolder = root.Folders(arrFolders(x)) Else Set objSelFolder = objSelFolder.Folders(arrFolders(x)) End If Next Debug.Print "Output from: ", objSelFolder.Name End Sub '============================================================ ' Module will open a File Dialog and allow users to select ' folder to save to ' Source: MS website '============================================================ Function GetFolder() 'Declare a variable as a FileDialog object. Dim fd As FileDialog 'Create a FileDialog object as a File Picker dialog box. Set fd = Access.Application.FileDialog(msoFileDialogFolderPicker) 'Declare a variable to contain the path 'of each selected item. Even though the path is a String, 'the variable must be a Variant because For Each...Next 'routines only work with Variants and Objects. Dim vrtSelectedItem As Variant 'Use a With...End With block to reference the FileDialog object. With fd 'Allow the selection of multiple files. .AllowMultiSelect = False 'Use the Show method to display the file picker dialog and return the user's action. 'If the user presses the action button... If .Show = -1 Then 'Step through each string in the FileDialogSelectedItems collection. For Each vrtSelectedItem In .SelectedItems 'vrtSelectedItem is a String that contains the path of each selected item. 'You can use any file I/O functions that you want to work with this path. 'This example simply displays the path in a message box. 'MsgBox "Selected item's path: " & vrtSelectedItem GetFolder = vrtSelectedItem Next 'If the user presses Cancel... Else End If End With 'Set the object variable to Nothing. Set fd = Nothing End Function '============================================================ ' Module will save or delete attachments depending on selection ' Inputs: Folder (folder object), Save (boolean: true = save) '============================================================ Sub Attachments(objFolder As Outlook.MAPIFolder, boolSave As Boolean) On Error Resume Next If boolSave And strFolder = "" Then MsgBox "If you want to save your attachments, you will need to select a directory to save to", vbOKOnly, "No Directory Selected" GetFolder Exit Sub End If 'Declare Variables Dim colItems Dim objMessage As MailItem Dim intCount As Integer Dim i Dim strExtension As String Const olFolderInbox = 6 'Set objects Set colItems = objFolder.Items 'Begin loop through all messages in folder (Inbox) For Each objMessage In colItems intCount = objMessage.Attachments.Count 'Check for attachments If intCount > 0 Then 'Debug.Print objMessage.SenderName, objMessage.Subject 'Begin loop to save attachments individually If boolSave Then For i = 1 To intCount strExtension = Right(objMessage.Attachments.Item(i).FileName, 3) If strExtension <> "bmp" And strExtension <> "gif" And strExtension <> "jpg" And strExtension <> "tif" Then Debug.Print strFolder & "\" & objMessage.SenderName & "_" & objMessage.Attachments.Item(i).FileName objMessage.Attachments.Item(i).SaveAsFile strFolder & "\" & objMessage.SenderName & "_" & _ objMessage.Attachments.Item(i).FileName End If Next End If 'Remove attachments from message 'Comment this line out if you're paranoid For i = 1 To intCount objMessage.Attachments.Remove i Next 'Save message (not completely necessary) objMessage.Save End If Next MsgBox "Process Completed" End Sub
A couple of notes:
- Add a reference to Access in the library because that’s what I use for the folder select.
- It does not save common image formats (bmp, gif, jpg) because lots of people use them in signatures.
- You will have to change your Macro permissions if you choose to not personally sign the macro, probably to Medium. Do not turn them off or change to Low. That’s just stupid.
The form is linked here as a “.doc”. You’ll need to rename it to a “.frx” to use it. Save the above code as “frmAttachment.frm”, import the .frx to Outlook and you should be ready to rock.
Run at your discretion and Voila! More space.