OK -- try this
This is the PPTM macro, and the 'Send With Outlook' module that is use is in the PPTM
Slide 2 has an embedded PPTX
Make sure you put your email address in to test
Option Explicit
Sub ExtractAndSend()
Dim oPres As Presentation
Dim oSlide As Slide
Dim oShape As Shape
Dim sEmbedded As String
Set oPres = ActivePresentation
For Each oSlide In oPres.Slides
For Each oShape In oSlide.Shapes
If oShape.Type = msoEmbeddedOLEObject Then
oShape.OLEFormat.DoVerb 2
sEmbedded = ActivePresentation.Name
DeleteFile oPres.Path & "\" & sEmbedded & ".pptx"
ActivePresentation.SaveAs (oPres.Path & "\" & sEmbedded & ".pptx")
ActivePresentation.Close
If SendWithOutlook("abc@somewhere.com", "Your Embedded File", "As Requested", oPres.Path & "\" & sEmbedded & ".pptx") Then
DeleteFile oPres.Path & "\" & sEmbedded & ".pptx"
MsgBox "Sent"
Else
MsgBox "Not Sent"
End If
Exit Sub
End If
Next
Next
End Sub
Private Sub DeleteFile(s As String)
On Error Resume Next
Application.DisplayAlerts = ppAlertsNone
Kill s
Application.DisplayAlerts = ppAlertsAll
On Error GoTo 0
End Sub