Save Incoming Attachments, Choose Your Folder

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).

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
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

Notice that the SelectFolder() Function does not include the trailing slash at the end, so we need to add this when saving the file.

If you wanted to simply use the same folder every time (for example, C:\MyFiles\), just comment out this line:

SelectedFolder = SelectFolder()

Remove the inner If-End-If statement (If SelectedFolder "" Then) and change this line:

myAttachments.Item(i).SaveAsFile SelectedFolder & "\" & Att

to this:

myAttachments.Item(i).SaveAsFile "C:\MyFiles\" & Att

But why would you want to do a thing like that, when the Shell automation is so much cooler?

Click here to see how to add this code to a toolbar button in Outlook.

Enjoy,
JP

About JP

I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space to learn more about VBA. Keep Reading »



Share This Article:

Share and bookmark this articledelicious buttonfacebook buttonlinkedin buttonstumbleupon buttontwitter button

comment bubble 5 Comment(s) on Save Incoming Attachments, Choose Your Folder:

  1. Hi JP,

    How are you ? U are doing a fine job in helping learners like me with reliable VBA codes. I need a favour from you. I have a macro in MS outlook named as "doit" and i want to call that outlook macro in excel2003. I googled a lot and got some hint as how to do it, but it not working error reads as " Object doesn't support this property or method ". Inspite of keeping the code in the default module ( Thisoutlooksession ) its not working. Please have a look at the snippet. Eagerly waiting 4 u respose. Thanks in advance.

    Sub trail1()
    Dim ol As Object
    Set ol = CreateObject("outlook.application")
    Call ol.doit
    End Sub

  2. Hey… i just rebooted my machine and now the same error is poping up (" Object doesn't support this property or method ".).. can u help me how to get rid of this error… Thanks.

  3. JP: Still good in Outlook 2003, except the SelectFolder function fails on my pc at
    "Set myShell = CreateObject(”Shell.Application”)"
    It's only for me, so I use an InputBox instead of the function call:
    folderName = InputBox("Path to save to: ", "Save Attachments To…", _
    "C:\Documents and Settings\user\Desktop\")

    It works well!

    Thanks,
    Phil in Ottawa Canada

This article is closed to any future comments.
Peltier Tech Charting Utilities for Excel