Electronics Lab Philippines

the email as a attachment in Outlook 2010

the email as a attachment in Outlook 2010
« on: May 22, 2017, 01:58:46 PM »

Here is my quetion. As my colleagues always send the important email as a  .msg  file in attachment to me. So I will select that .msg  file and  drag them to my folder to open that email directly. I need to do that for many times everyday.

So I hope that there is a way that outlook will auto open the .msg file in the attachment in an incoming email . But I can't find a way to do that. Any ideas?

Re: the email as a attachment in Outlook 2010
« Reply #1 on: May 25, 2017, 03:05:43 PM »
You can just do that via VBA 、A macro will help you as below:

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

And i also attach the link of the macro here ,you can find more details in the article, just google it:

"How to Auto Extract Attached Messages from an Incoming Email Message to Your Inbox"

Good luck.