Save Incoming Attachments, Choose Your Folder
May 23, 2008 • JP • 4 Comments • Rate This Article
• Links to this article
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).
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
' 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:
Remove the inner If-End-If statement (If SelectedFolder "" Then) and change this line:
to this:
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
Previous Post: Read those image files in Outlook
Next Post: XML Parsing Function



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
"doit" must be a Public Sub or Function. See Google Groups for reference.
Thanks a ton pal.. I declared "doit" it as public and xl code is able to read the outlook code…. Thanks.
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.