An Outlook user posted a question in Outlook Forums:
I need to open Outlook messages stored in a specific folder, and then get the attachments from those Outlook items.
You can do this. You need to use Windows Scripting Host and Outlook's Application.CreateItemFromTemplate to open the messages. Once open, you can save the attachments or do whatever you need to do to the message.
To use this macro, paste the macro in a module, then set a reference to Microsoft Scripting Runtime in the VB Editor's Tools, References dialog box.
You'll need to enter the folder path where the MSG files are stored to the GetMSG macro. The folder where you want to save the attachments is stored in strFolderpath in the ListFilesInFolder macro.
Click in GetMSG and press F5 or Run to use the macro.
This code is not Outlook-specific (except for the code between the two Set openMsg lines) and can be used with Word or Excel.
Sub GetMSG() ' True includes subfolders ' False to check only listed folder ListFilesInFolder "E:\My Documents\", True End Sub Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean) Dim FSO As Scripting.FileSystemObject Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder Dim FileItem As Scripting.File Dim strFile, strFileType, strAttach As String Dim openMsg As MailItem Dim objAttachments As Outlook.Attachments Dim i As Long Dim lngCount As Long Dim strFolderpath As String 'where to save attachments strFolderpath = "E:\My Documents\attachments\" Set FSO = New Scripting.FileSystemObject Set SourceFolder = FSO.GetFolder(SourceFolderName) For Each FileItem In SourceFolder.Files strFile = FileItem.name ' This code looks at the last 4 characters in a filename ' If we wanted more than .msg, we'd use Case Select statement strFileType = LCase$(Right$(strFile, 4)) If strFileType = ".msg" Then Debug.Print FileItem.Path Set openMsg = Application.CreateItemFromTemplate(FileItem.Path) openMsg.Display 'do whatever Set objAttachments = openMsg.Attachments lngCount = objAttachments.count If lngCount > 0 Then For i = lngCount To 1 Step -1 ' Get the file name. strAttach = objAttachments.Item(i).FileName ' Combine with the path to the Temp folder. strAttach = strFolderpath & strAttach ' Save the attachment as a file. objAttachments.Item(i).SaveAsFile strAttach Next i End If openMsg.Close olDiscard Set objAttachments = Nothing Set openMsg = Nothing ' end do whatever End If Next FileItem If IncludeSubfolders Then For Each SubFolder In SourceFolder.SubFolders ListFilesInFolder SubFolder.Path, True Next SubFolder End If Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub
How to use the macro
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, 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.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor