How do change this code to save the email attachment PPT file as a PDF instead?

Question

0.00/5 (No votes)

See more:

Sub Torecognitionplus()

Dim objActivePresetation As Presentation
    Dim objSlide As Slide
    Dim n As Long
    Dim strName As String
    Dim strTempPresetation As String
    Dim objTempPresetation As Presentation
    Dim objOutlookApp As Object
    Dim objMail As Object
 
    Set objActivePresetation = ActivePresentation
 
    For Each objSlide In objActivePresetation.Slides
        objSlide.Tags.Delete ("Selected")
    Next
 
    'Add a tag "Selected" to the selected slides
    For n = 1 To ActiveWindow.Selection.SlideRange.Count
        ActiveWindow.Selection.SlideRange(n).Tags.Add "Selected", "YES"
    Next n
 
    strName = objActivePresetation.Name
    strName = Left(strName, InStrRev(strName, ".") - 1)
    strTempPresetation = Environ("TEMP") & "\" & strName & ".pptx"
 
    'Copy the active presentation to a temp presentation
    objActivePresetation.SaveCopyAs strTempPresetation
    Set objTempPresetation = Presentations.Open(strTempPresetation)
 
    'Remove the untagged slides
    For n = objTempPresetation.Slides.Count To 1 Step -1
        If objTempPresetation.Slides(n).Tags("Selected") <> "YES" Then
           objTempPresetation.Slides(n).Delete
        End If
    Next n
 
    objTempPresetation.Save
    objTempPresetation.Close
 
    'Attach the temp presentation to a new email
    Set objOutlookApp = CreateObject("Outlook.Application")
    Set objMail = objOutlookApp.CreateItem(olMailItem)
 
    'Change the email details as per your needs
    With objMail
         .To = "insert emailhere"
         .Subject = strName
         .Body = "Dear companyX," & vbCr & vbCr & "Please see attached Plaques.," & vbCr & "Please let me know if you need any further assistance."
         .Attachments.Add strTempPresetation
         .Display
    End With
End Sub

What I have tried:

This does work correctly and attaches to email as a PPT File. I need the selected slides in PPT exported as a PDF attachment instead. Can't seem to get it to work.

Posted 5-Aug-21 5:31am

Brian Chiasson

Updated 5-Aug-21 5:51am

Add a Solution

Comments

CHill60 5-Aug-21 11:34am

"Can't seem to get it to work." does not help us to help you. What went wrong? Importantly what code did you try? (This code only saves a pptx)
Did you try using ~~saveas"?~~
ExportAsFixedFormat

2 solutions

Solution 1

I've just used this code snippet to save one of my own .pptx files as a pdf

VB

Dim oPresentation As Presentation
    Set oPresentation = ActivePresentation
    
    Dim targetFolder As String, targetFile As String
    targetFolder = oPresentation.Path
    targetFile = Replace(oPresentation.Name, ".pptx", ".pdf")
    
    oPresentation.ExportAsFixedFormat Path:=targetFolder & "\" & targetFile, FixedFormatType:=ppFixedFormatTypePDF

Posted 5-Aug-21 5:49am

CHill60

Add a Solution

Add your solution here

Treat my content as plain text, not as HTML

Preview 0

…

Existing Members

Sign in to your account

...or Join us

Download, Vote, Comment, Publish.

Your Email
Password
Forgot your password?

Your Email
This email is in use. Do you need your password?
Optional Password

I have read and agree to the Terms of Service and Privacy Policy
Please subscribe me to the CodeProject newsletters

When answering a question please:

Read the question carefully.
Understand that English isn't everyone's first language so be lenient of bad spelling and grammar.
If a question is poorly phrased then either ask for clarification, ignore it, or edit the question and fix the problem. Insults are not welcome.
Don't tell someone to read the manual. Chances are they have and don't get it. Provide an answer or move on to the next question.

Let's work to help developers, not make them feel stupid.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Richard Deeming · Accepted Answer · 2021-08-05T05:51:00

Presentation.SaveAs method (PowerPoint) | Microsoft Docs[^]

VB

strTempPresetation = Environ("TEMP") & "\" & strName & ".pptx"
 
'Copy the active presentation to a temp presentation
objActivePresetation.SaveCopyAs strTempPresetation
Set objTempPresetation = Presentations.Open(strTempPresetation)
 
'Remove the untagged slides
For n = objTempPresetation.Slides.Count To 1 Step -1
    If objTempPresetation.Slides(n).Tags("Selected") <> "YES" Then
        objTempPresetation.Slides(n).Delete
    End If
Next n

Dim strPdfName As String
strPdfName = Environ("TEMP") & "\" & strName & ".pdf"
objTempPresetation.SaveAs strPdfName, ppSaveAsPDF
objTempPresetation.Close

...

With objMail
   ...
   .Attachments.Add strPdfName
   ...