Save Incoming Attachments, Choose Your Folder
May 23, 2008 @ 1:46 AM by JP • 1 views • No Comments »
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






Speak Your Mind
Tell us what you're thinking...and oh, if you want a pic to show with your comment, go get a gravatar!
Certain comments (including first-time comments) are subject to moderation and will not appear immediately. Please view the Comment Policy for more information. To post VBA code in your comment, use tags like this: [cc lang='vb']Code goes here[/cc].