Code For Excel And Outlook Blog

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

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

 Print This Post  |   Email This Post  |   Subscribe to Posts Feed  |   Subscribe to Comments

Filed Under: Outlook, VBA, automation
Tags: attachments, Outlook, Shell, VBA