Save Incoming Attachments, Choose Your Folder

May 23, 2008 – 1:46 am by JP

Here's a sub and a function for Outlook that let's you save attachments from a selected or open email. It's similar to the File>Save Attachments menu option, which lets you save all of the attachments from a particular email, or the FindControl Method, which can be used to find and execute "Save Attachments".

Now I realize that there is already a ton of code available that you can use to save attachments, but I found some code that uses the Shell application to let you pick the folder you want to use as the destination. So my purpose here is to demonstrate how to use this code in a simple routine.

It's a great technique and, since it is a separate function, it is very portable to other subs where you want to let the user pick a folder on their hard drive or network drive as the destination for files you want to save or use in a routine. It simply returns the full path as a string.

As you can see below, the String variable "SelectedFolder" is used to store the returned results from the SelectFolder() Function.

As usual, we set an object reference to a Mail Item, then loop through the attachments collection of that mail item and save each one. Notice that the bulk of the work is done inside the If statement (but outside the loop) to avoid costly object references that might be useless if the email doesn't have attachments (for example, if you run this code on the wrong email by mistake).

plain text version

VBA:

Sub GoThroughAttachments()
Dim MyItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Dim i As Long
Dim Att As String
Dim SelectedFolder As String
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set MyItem = ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set MyItem = ActiveInspector.CurrentItem
Case Else
End Select
On Error GoTo 0
If MyItem Is Nothing Then
GoTo ExitProc
End If
If MyItem.Attachments.Count> 0 Then
SelectedFolder = SelectFolder()
If SelectedFolder <> "" Then
' user didn’t press Cancel
Set myAttachments = MyItem.Attachments
For i = 1 To myAttachments.Count
Att = myAttachments.Item(i).DisplayName
myAttachments.Item(i).SaveAsFile SelectedFolder & "\" & Att
Next i
End If
End If
ExitProc:
Set myAttachments = Nothing
Set MyItem = Nothing
End Sub

plain text version

VBA:

Private Function SelectFolder(Optional i_RootFolder As String) As String
' from http://vba-corner.livejournal.com/
Dim myShell As Object
Dim MyFolder As Object
Set myShell = CreateObject(”Shell.Application”)
If i_RootFolder = "" Then
'no root folder given, use default (which is Desktop)
Set MyFolder = myShell.BrowseForFolder(0, "Please select a folder:", 1)
ElseIf Not (i_RootFolder Like "*[!0123456789]*") Then
'number for special folder given
Set MyFolder = myShell.BrowseForFolder(0, "Please select a folder:", 1, CInt(i_RootFolder))
Else
'path for root folder given
Set MyFolder = myShell.BrowseForFolder(0, "Please select a folder:", 1, CStr(i_RootFolder))
End If
If Not MyFolder Is Nothing Then
SelectFolder = MyFolder.self.Path
End If
End Function