' Install Redemption 
' http://www.dimastr.com/redemption/download.htm


Sub GetAttachmentInfo()
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")

Dim olNS As Outlook.NameSpace
Set olNS = olApp.GetNamespace("MAPI")

Dim oRDOSession As Redemption.RDOSession
Set oRDOSession = CreateObject("Redemption.RDOSession")
oRDOSession.MAPIOBJECT = olNS.Application.Session.MAPIOBJECT

Set Mail = olApp.ActiveExplorer.Selection.Item(1)
Debug.Print Mail.EntryID
Set Mail = oRDOSession.GetMessageFromID(Mail.EntryID)
For Each att In Mail.Attachments
  Debug.Print att.FileName
  Debug.Print att.EmbeddedMsg
  Debug.Print att.EmbeddedMsg.To
  Debug.Print att.EmbeddedMsg.SenderEmailAddress
Next
End Sub