Embedded Msg, in Outlook, with a Word Doc - how to get at Embedded Msg as Attachment?

I have code that I have experimented with, that is looking at a particular Mail folder, and looking for infomation within an attachment, that has an attachment.
An Email in the inbox, has an embedded email message, that has a Word Document attached.
So, Last Sender, sends an email, from First Sender that is an embedded attachment, and There is
a Word Document from First Sender.

I can get to the embedded email- of First Sender which looks like a FILE with an extension of .Msg
and I can save that to disk, and when I open it from disk, I see the word Doc attachment.

 Dim objOutLook As Outlook.Application
     Dim objNameSpace As Outlook.NameSpace
     Dim objFolders As Outlook.Folders
     Dim objFolder As Outlook.MAPIFolder
     Dim objItem As Outlook.MailItem
     Dim objAttachment As Attachment
     Dim objParmAttachment As Object
     Dim objFSO As FileSystemObject
     Dim strSaveToPath As String
     Dim strFilename As String
     Dim intCount As Integer
   
   
    strSaveToPath = "C:\Data\Test\"
         Set objOutLook = CreateObject("Outlook.Application")
     Set objNameSpace = objOutLook.GetNamespace("MAPI") ' Reference Outlook namespace
     Set objFolders = objNameSpace.Folders.Item("Mailbox - Support").Folders
     If objFolders.Count > 0 Then
     Set objFolder = objFolders.Item("Inbox")
     '* the objFolder of the Inbox has the Items to be Processed
     '* We can then get access to each item by looping through the inbox
     '* And we can determine if there are attachements in the item.
     Set objItem = objFolder.Items(1)
     If objItem.Attachments.Count > 0 Then
        Set objAttachment = objItem.Attachments.Item(1)
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        strFilename = objAttachment.FileName
        intCount = 1
        Do While True
            If objFSO.FileExists(strSaveToPath & strFilename) Then
                strFilename = objFSO.GetBaseName(objAttachment.FileName) & "(" & intCount & ")." & objFSO.GetExtensionName(objAttachment.FileName)
                intCount = intCount + 1
            Else
                objAttachment.SaveAsFile strSaveToPath & strFilename
                Exit Do
            End If
        Loop
       
     End If

.......... END OF CODE CLIP

I am hitting my head on the wall trying to see how to get this.
Start Free Trial