Outlook Attachment Extractor

Introduction

Have you ever tried to download attachments from more than one message in Outlook?

Background

I have a lot of messages in Outlook, personal, job-related, humorous, etc. I wanted to start tidying up my messages, and one thing I wanted to do was extract all the attachments in a given folder and save them to a specified location, to reduce the size of my Outlook data file. I can select a message, then go to File -> Save Attachments, and that's it. But selecting more than one message disables this menu item?

This approach may not be (actually, is not) the best, and there are much better ways to do it in managed code. But I'm running Windows Vista x64 with Office 2007, and Visual Studio (with SP1 for Vista) still doesn't play good with these, so I put together a VBA Macro that will help you if you want a quick solution.

Using the code

As there are no classes, objects or anything like that in vba (don't get me started with that, let's just say there aren't any), I'll copy-paste the macro and comment most lines so you know what to edit to make this macro fit your needs.

Sub GetAttachments()
    'If an error occurs, such as the target or destination folder 
    'don't exist, then go to the "GetAttachments_err" tag
    On Error GoTo GetAttachments_err
    'Create (dimensionate) the variables we're using, 
    'including the ones we use in the cycles
     
    'This is the variable that will hold the folder we want to process
    Dim folder As MAPIFolder
    'This is a generic variable that will be used in Cycle(1), 
    'and will hold a reference to the current item in a folder
    'being evaluated. It is an object because a folder item 
    'could be a mail message, a folder, or several other item types
    Dim item As Object
    'This is the variable that will hold a reference to each attachment 
    'we'll process, and has the methods for saving it
    Dim attachment As attachment
    'This is a variable that will have the full path for the saved file, 
    'and will be used to save the attachment
    Dim fileName As String
    'This is only a counter that will count how many attachments 
    'were processed (saved)
    Dim attachmentCount As Integer
    
    'I've separated the following variables, because it's easier 
    'to understand them like this.
    'You could declare them with the rest without problem
    
    'This variable will be used to process the target folder 
    'in Outlook's tree structure.
    Dim folderPath As String
    'The user will enter a full path (without "Personal Folders" 
    'at the beginning), and the macro will automatically
    'reference the corresponding object.
    'This instruction shows a dialog box where the user must enter 
    'the target folder path, using "\" as a separator
    folderPath = InputBox("Please enter the target folder path, _
        using '\' as a separator", _
        "Please choose the folder to process")
    
    'This variable is used together with slashPosition to divide 
    'folderPath and reach the target folder
    Dim start As Integer
    start = 1 'In VBA collections start from 1, not from 0 as in C#
    
    'This variable is used together with slashPosition to divide 
    'folderPath and reach the target folder
    Dim slashPosition As Integer
    'We now use the InStr function, which receives the start position 
    '(optional), a source string, a string to look for
    'in the first string, and a comparison method, binary, directory or text. 
    'We use the last one
    slashPosition = InStr(start, folderPath, "\", vbTextCompare)
        
    'Session is the object that corresponds to the current user session. 
    'It has a Folders collection, where you have the
    'root folders, such as "Personal Folders". 
    'The first one (remember that collections start in 1) is Personal Folders.
    Set folder = Session.Folders.item(1)
    
    'This will help us to get the reference to the specified folder 
    'in the hierarchy
    While slashPosition > 0 '"while there are more slashes in the string
        'The folders collection can be accessed by folder name. 
        'What we do here is set same folder option as it's child,
        'by accessing the folders collection using the result of the 
        'Mid function call. This function receives a string,
        'a start position and an amount of characters, 
        'and returns the sub-string
        Set folder = folder.Folders
            (Mid(folderPath, start, slashPosition - start))
       
        'After we assigned the folder object, 
        'we set the variables that control the cycle
        'This "If" is used to check if the text entered by the user 
        'ends with "\"
        If (slashPosition < Len(folderPath)) Then
            ' The start position is the character next to the "\"
            start = slashPosition + 1
            slashPosition = InStr(start, folderPath, "\", vbTextCompare)
        End If
    Wend
    
    'After we processed the string, we set the folder to the last item 
    'of the hierarchy.
    'If there were no slashes on the text entered by the user, 
    'then this is the only instruction executed; the cycle is not used
    'We subtract 1 from "start" because "collections in VBA start in 1"
    '(believe it or not, this was one of my headaches when writing this macro)
    Set folder = folder.Folders(Mid(folderPath, start, Len(folderPath) - _
                                (start - 1)))
        
    'We set the attachment count in 0
    attachmentCount = 0
    
    'If there are no subitems in the selected folder, 
    'then the macro shows a message and exits
    If folder.Items.Count = 0 Then
        MsgBox "There are no messages in the selected folder, _
        so no attachment will be saved.", vbInformation, "Done"
        Exit Sub
    End If
    
    'This variable holds the path to the folder where the attachments 
    'will be saved
    Dim saveFolderPath As String
    'We use the same method as above, 
    '"InputBox", with an extra (optional) parameter, "DefaultValue"
    saveFolderPath = InputBox("Ingrese el path de la carpeta de destino", _
                "Elija la carpeta de destino", "E:\tmp")
    
    'Cycle(1)
    For Each item In folder.Items 'For each item in the folder
        For Each attachment In item.Attachments 
        'Every item, disregarding it's type, has the attachment collection
            'We set the file name for this attachment using the path chosen by 
        'the user and the filename of the attachment
            fileName = saveFolderPath + "\" & attachment.fileName
            'We call the "SaveAsFile" method of the attachment object 
        'and pass "filename" as a parameter to save it to
            'the desired location
            attachment.SaveAsFile fileName
            'We increment the attachment count variable
            attachmentCount = attachmentCount + 1
        Next attachment
    Next item
    
    'If at least one attachemt was saved, we show the user how many and 
    'where they were saved
    If attachmentCount = 1 Then
        MsgBox attachmentCount & " attachments was found." _
        & vbCrLf & "They were saved in " + saveFolderPath + ".", _
                        vbInformation, "Done!"
    Else
        If attachmentCount > 1 Then
            MsgBox attachmentCount & " attachments were found." _
            & vbCrLf & "They were saved in " + saveFolderPath + ".", _
                        vbInformation, "Done!"
        Else
            MsgBox "No attachment was found.", vbInformation, "Done!"
        End If
    End If
    
'We dispose the objects we used by setting them null
GetAttachments_exit:
   Set attachment = Nothing
   Set item = Nothing
   Exit Sub

'If there is any error, this code section is executed, after which 
'the objects are disposed by resuming execution at
'"GetAttachments_exit"
GetAttachments_err:
    MsgBox "An unexpected error has occurred." _
      & vbCrLf & "Please note and report the following information." _
      & vbCrLf & "Macro Name: GetAttachments" _
      & vbCrLf & "Error Number: " & Err.Number _
      & vbCrLf & "Error Description: " & Err.Description _
      , vbCritical, "Error!"
   Resume GetAttachments_exit
End Sub 

Points of Interest

There are many ways in which you can customize this Macro, such as setting the date and time of the message as part of the filename, or filtering the file types just to download JPGs, but this article is meant to be used as a quick solution to an everyday (well, maybe once a week) problem.

That said, if you need any assistance in customizing the code, feel free to contact me.

History

• June 11, 2007: First version