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.
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
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
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:
This version of the macro is a run a script macro. It saves the attachment to the hard drive, open it (hidden), then saves it to the calendar and deletes it from the hard drive.
Public Sub SaveandOpenAttachments(objMsg As mailitem) Dim objAttachments As Outlook.Attachments Dim i As Long Dim lngCount As Long Dim strFile As String Dim strFolderpath As String Dim oAppt As Object ' Get the path to your My Documents folder strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) On Error Resume Next ' Set the Attachment folder. (Folder must exist.) strFolderpath = strFolderpath & "\Att temp\" 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 Debug.Print strFile objAttachments.item(i).SaveAsFile strFile Set oAppt = Session.OpenSharedItem(strFile) oAppt.Close olSave ' should delete strfile too SetAttr strFile, vbNormal Kill strFile Next End If ExitSub: Set objAttachments = Nothing End Sub
To test the run a script macro without sending yourself messages, use this stub macro. Select a message then run the macro. It calls the run a script macro, just as a rule would. You can also use this macro to run the script "manually".
Sub RunScript() Dim objApp As Outlook.Application Dim objItem As mailitem Set objApp = Application Set objItem = objApp.ActiveExplorer.Selection.item(1) 'macro name you want to run goes here SaveandOpenAttachments objItem End Sub
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 and newer, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security. If Outlook tells you it needs to be restarted, close and reopen Outlook. Note: after you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Now open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
More information as well as screenshots are at How to use the VBA Editor.
To save and open specific attachment types (for example, only open doc and xls files) as the messages arrive, see Attachment: Print received attachments immediately. Change "print" to "open" in the ShellExecute line of that code:
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
to
ShellExecute 0, "open", sFile, vbNullString, vbNullString, 0