When you receive an email that is attached with several Outlook messages, you may wish to extract these attached messages to your Inbox. Thus, in this article, we will teach you how to use VBA to let Outlook auto accomplish it.
As we all know, not only can Outlook permit you to attach local files, but also you can attach various Outlook items, no matter messages, contacts and tasks, etc. So, if you receive any emails which are attached with Outlook messages, in order to check the attached messages more conveniently in future, you may desire to extract and save them to your Inbox directly. In general, to accomplish it, you can simply select the attached emails and then drag them to Inbox. However, many users even hope that Outlook can automatically do this. In response to this, we’ll introduce you a quick method which can use VBA to quickly achieve it.
Auto Extract Attached Messages from an Incoming Email Message to Inbox
- In the first place, launch your Outlook program.
- Then press “Alt + F11” key shortcuts in main Outlook window.
- Next in the subsequent VBA editor, you should open the “ThisOutlookSession” project.
- Later, copy and paste the following VBA codes into the project window.
Public WithEvents objItems As Outlook.Items Private Sub Application_Startup() Set objItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items End Sub Private Sub objItems_ItemAdd(ByVal Item As Object) Dim objMail As Outlook.MailItem Dim objAttachments As Outlook.attachments Dim i As Long Dim objAttachedEmail As Outlook.Attachment Dim objFileSystem As Object Dim strTempFolderPath As String Dim objWsShell As Object Dim objInspectors As Outlook.Inspectors Dim objInbox As Outlook.Folder Dim objItem As Outlook.MailItem Dim objCopy As Outlook.MailItem On Error Resume Next If Item.Class = olMail Then Set objMail = Item Set objAttachments = objMail.attachments If objAttachments.Count > 0 Then For i = objAttachments.Count To 1 Step -1 'Get the attached messages If Right(LCase(objAttachments.Item(i).filename), 3) = "msg" Then Set objAttachedEmail = objAttachments.Item(i) 'Save the attached messages in the temporary folder Set objFileSystem = CreateObject("Scripting.FileSystemObject") strTempFolderPath = objFileSystem.GetSpecialFolder(2).Path & "\" & objAttachedEmail.filename objAttachedEmail.SaveAsFile (strTempFolderPath) 'Copy the attached files to Inbox Set objItem = Outlook.Application.CreateItemFromTemplate(strTempFolderPath) objItem.Subject = objItem.Subject & " Attached in " & objMail.Subject Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox) objItem.Move objInbox 'Delete the message files from the temporary folder objFileSystem.DeleteFile (strTempFolderPath) End If Next i End If End If End Sub
- After that, sign this macro.
- Subsequently, change Outlook macro security settings to permit the digitally signed macros.
- Eventually, restart your Outlook to activate the new macro.
- From now on, Outlook will automatically extract the attached messages from the incoming emails to Inbox folder, like the following screenshot:
Get Rid of Hateful PST Data Loss
You must have much valuable data in your Outlook PST file. Therefore, in order to escape from painful PST data loss, you should build some good habits, including making consistent and regular backups for your PST file and keeping closing your Outlook properly, etc. Moreover, it is recommended to keep a remarkable PST fix tool in vicinity, such as DataNumen Outlook Repair.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including damaged SQL Server and outlook repair software products. For more information visit www.datanumen.com