Consulting

Results 1 to 8 of 8

Thread: Attaching embedded ppt object to the outlook mail using VBA

  1. #1

    Attaching embedded ppt object to the outlook mail using VBA

    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"
    Last edited by Paul_Hossler; 10-17-2019 at 12:07 PM.

  2. #2
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,755
    Location
    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
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    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..

    Quote Originally Posted by Paul_Hossler View Post
    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

  4. #4
    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..

  5. #5
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,755
    Location
    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?
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  6. #6
    Quote Originally Posted by Paul_Hossler View Post
    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.

  7. #7
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,755
    Location
    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
    Attached Files Attached Files
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  8. #8
    Quote Originally Posted by Paul_Hossler View Post
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •