vbaoutlookemail-attachmentsexplorersavefiledialog

How Do I Browse Windows Folders And Save An Outlook Attachment There Using Outlook VBA


I would like to save an Outlook attachment using Outlook VBA with the ability to browse for a destination folder in windows prior to the save. I have found the thread "Save attachments to a folder and rename them" as well as several other threads through google.

All of the solutions I have found so far include the folder path as text within the code like folderStr = "C:\Users\ME\Documents". The file path then has the specific attachment name attached to the string and possibly a sub folder that needs to already exist on the computer.

I am using the following pair of functions in Excel VBA but when I tried to use them in Outlook it failed. I double checked the reference libraries but maybe I missed something else in the implementation.

Function SHGetPathFromIDList Lib "shell32.dll"
Function SHBrowseForFolder Lib "shell32.dll"

I am beginning to believe that this is not possible from within the Outlook VBA module. Any help is appreciated.


Solution

  • You are free to use any Windows API functions from Outlook VBA, just need to declare them correctly according to the host/OS bitness, for example, see How to use Windows SHBrowseforFolder function on 32 bit or 64 bit Excel VBA.

    The Outlook object model provides the SaveAsFile method which saves the attachment to the specified path. The location at which to save the attachment is represented by the parameter of type string.

    Sub SaveAttachment() 
     Dim myInspector As Outlook.Inspector 
     Dim myItem As Outlook.MailItem 
     Dim myAttachments As Outlook.Attachments 
     
     Set myInspector = Application.ActiveInspector 
     If Not TypeName(myInspector) = "Nothing" Then 
       If TypeName(myInspector.CurrentItem) = "MailItem" Then 
         Set myItem = myInspector.CurrentItem 
         Set myAttachments = myItem.Attachments 
         'Prompt the user for confirmation 
         Dim strPrompt As String 
         strPrompt = "Are you sure you want to save the first attachment in the current item to the Documents folder? If a file with the same name already exists in the destination folder, it will be overwritten with this copy of the file." 
         If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then 
           myAttachments.Item(1).SaveAsFile Environ("HOMEPATH") & "\My Documents\" & myAttachments.Item(1).DisplayName 
         End If 
       Else 
         MsgBox "The item is of the wrong type." 
       End If 
     End If 
    End Sub