Save and Open an Attachment using VBA

A visitor wanted to know how to save attachments and then open them without opening Windows Explorer to find the attachment. This VBA code is based on the code sample at our Outlook-Tips site: Save and Delete Attachments. We removed the lines that delete the attachment from the message and added the file path to the message body, using the file path to open the message using Window's ShellExecute command.

The macro at Save Attachments to the hard drive is the original macro this code was built from. It saves attachments on the selected messages but does not open them.

Save and Open Attachments VBA Sample

To use this code sample, open the VBA editor by pressing Alt+F11 keys. Paste the code into the ThisOutlookSession module. If it does not exist, create the directory path on your hard drive then update the code with the path.

Select one or more attachments and run the macro.

For more information, see How to use VBA Editor

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
  "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Sub SaveandOpenAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strExePath As String

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    
    On Error Resume Next
    Set objOL = CreateObject("Outlook.Application")
    Set objSelection = objOL.ActiveExplorer.Selection

    ' Set the Attachment folder. (Folder must exist.) 
    strFolderpath = strFolderpath & "\OLAttachments\"

    For Each objMsg In objSelection
    Set objAttachments = objMsg.Attachments
    
    lngCount = objAttachments.Count
      If lngCount > 0 Then
        For i = lngCount To 1 Step -1
         strFile = objAttachments.Item(i).FileName
         strFile = strFolderpath & strFile
         objAttachments.Item(i).SaveAsFile strFile

    'use ShellExecute to open the file
    'this may not work with zip extension if you use Compressed folders
    ShellExecute 0, "open", strFile, vbNullString, vbNullString, 0
    
    Next
    End If
    Next
    
ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

Use with 64-bit Outlook

To use this with 64-bit Outlook, replace the Declare line with this:

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias _
  "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Open hidden attachments on Outlook.com items

To use this to open hidden attachments on Outlook.com items, change the objMsg line to this:

Dim objMsg as Object 

Use the Temp folder instead of My Documents, delete
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
and replace
strFolderpath = strFolderpath & "\OLAttachments\" with this:

strFolderpath = VBA.Environ$("Tmp") & "\"

ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0

ShellExecute 0, "open", sFile, vbNullString, vbNullString, 0