Attaching embedded ppt object to the outlook mail using VBA

[Paul_Hossler]

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

[CuriosityBug]

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

Hello Paul,

Thanks for the input. I solved this using different method but the way you used to save in a path, helped me to get idea.

Thanks again for always being there. Marking as solved which can also be helpful to others.

[SillyStallio]

Hello Paul,

Thanks for the input. I solved this using different method but the way you used to save in a path, helped me to get idea.

Thanks again for always being there. Marking as solved which can also be helpful to others.

Could I asked how you solved it as none of the solutions above seem to be working for me?