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()
On Error GoTo GetAttachments_err
Dim folder As MAPIFolder
Dim item As Object
Dim attachment As attachment
Dim fileName As String
Dim attachmentCount As Integer
Dim folderPath As String
folderPath = InputBox("Please enter the target folder path, _
using '\' as a separator", _
"Please choose the folder to process")
Dim start As Integer
start = 1
Dim slashPosition As Integer
slashPosition = InStr(start, folderPath, "\", vbTextCompare)
Set folder = Session.Folders.item(1)
While slashPosition > 0
Set folder = folder.Folders
(Mid(folderPath, start, slashPosition - start))
If (slashPosition < Len(folderPath)) Then
start = slashPosition + 1
slashPosition = InStr(start, folderPath, "\", vbTextCompare)
End If
Wend
Set folder = folder.Folders(Mid(folderPath, start, Len(folderPath) - _
(start - 1)))
attachmentCount = 0
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
Dim saveFolderPath As String
saveFolderPath = InputBox("Ingrese el path de la carpeta de destino", _
"Elija la carpeta de destino", "E:\tmp")
For Each item In folder.Items
For Each attachment In item.Attachments
fileName = saveFolderPath + "\" & attachment.fileName
attachment.SaveAsFile fileName
attachmentCount = attachmentCount + 1
Next attachment
Next item
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
GetAttachments_exit:
Set attachment = Nothing
Set item = Nothing
Exit Sub
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