Attaching embedded ppt object to the outlook mail using VBA

[CuriosityBug]

Hello Everyone,


I have been hustling to do the following:

1. Copy all slides from current presentation which has macros (with .pptm extension) into an embedded/hidden/OLE object with .pptx extension.
2. Attach this pptx to outlook mail

The reason to do this is to avoid virus while attaching macro contained PowerPoint. Please help, that will be like ray of hope. Following is drafts of code I am working on;

They are two approaches which came into my mind.
1. One is using similar thread : http://www.vbaexpress.com/forum/show...ook-attachment

Code:

Dim OutlookApp As Object
Dim OutlookMessage As Object
Dim otemp As presentation
Dim opres As presentation
Dim strName As String
Dim strSubject As String




Dim L As Long


Set opres = ActivePresentation


strSubject = opres.name


' make a copy
opres.SaveCopyAs Environ("TEMP") & "" & strName & ".pptx"
'open the copy
Set otemp = Presentations.Open(Environ("TEMP") & "" & strName & ".pptx")
otemp.Save
otemp.Close
On Error Resume Next
Set OutlookApp = GetObject(Class:="Outlook.Application")
Err.Clear
If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(Class:="Outlook.Application")
On Error GoTo 0
Set OutlookMessage = OutlookApp.CreateItem(0)


On Error Resume Next
With OutlookMessage
.To = "username.gmail.com" 'Insert email address here!
.CC = ""
.Subject = strSubject
.body = "Slides are attached"
.Attachments.Add Environ("TEMP") & "" & strName & ".pptx"
.Display
End With
End Sub

2. Copying all slides from pptm file into the embedded and then attaching this pptx file to outlook (just an idea)

PPTMainPres is the presentation with macros 
PPTPres is the OLE hidden/embedded object

 Set PPTPres = oOleObj ' embedded presentation or object
     PPTMainPres.Slides.Range.Copy
     PPTPres.Slides.Paste
---------------------------

 .Attachments.Add PPTPres  ".pptx"

[Paul_Hossler]

1. Copy all slides from current presentation which has macros (with .pptm extension) into an embedded/hidden/OLE object with .pptx extension.
2. Attach this pptx to outlook mail

The reason to do this is to avoid virus while attaching macro contained PowerPoint. Please help, that will be like ray of hope. Following is drafts of code I am working on;

I suspect that any AV checker would be very suspicious about a file trying to hide the fact that it has macros

Do you need the macros with the file?

Assuming that you do, then I think the best would be to just create an Outlook session in the macro and attach the PPTM file


PS -- I added CODE tags to your post

[CuriosityBug]

Hello Paul,

I want to attach a pptx file. The OLE object is plain pptx file with no macros in it (no need of macros along with it). I would like to copy all slides to the this pptx file from main presentation pptm file. So that content after running macros is copied into this embedded object.

Thanks for replying Paul..

I suspect that any AV checker would be very suspicious about a file trying to hide the fact that it has macros

Do you need the macros with the file?

Assuming that you do, then I think the best would be to just create an Outlook session in the macro and attach the PPTM file


PS -- I added CODE tags to your post

[CuriosityBug]

i.e outcome after running macros. I got copying of content into this embedded object part but the rest of attaching it to outlook application is where I got struck..

[Paul_Hossler]

Q: so you have a PPTM file that has an OLE embedded PPTX file, and you want to email the PPTX file out?

Q: is the PPTX file on the same slide every time, and is there only the one?

[CuriosityBug]

Q: so you have a PPTM file that has an OLE embedded PPTX file, and you want to email the PPTX file out?

Q: is the PPTX file on the same slide every time, and is there only the one?

Hello Paul,

Exactly, both statements is what I am trying to achieve ! There is only one OLE object (OLE embedded PPTX file) and in same slide every time. Thank you.

[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?