Saving all open PPT within Excel

[Adam_P]

Hi all - thank you so much with my previous question (literally saved me hours each month!)

Question
I have an Excel Workbook that exports standardised reports each month directly in to a fresh PowerPoint file. This works great, but the problem I have is that I suddenly have 20 open PowerPoint presentations and saving manually takes a frustratingly long time.

Is there a way (within Excel) to save (and close) all of these newly created reports in PowerPoint to a specific destination?

Thanks again!
Adam

 

[Trebor76]

Hi Adam,

Try this:

Option Explicit
Sub Macro1()

    Dim objPP_App As Object
    Dim objPP_Pres As Object
    Dim i As Long
    Dim strSavePath As String
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
        'Check if an instance of PowerPoint exists
        Set objPP_App = GetObject(, "PowerPoint.Application")
        'If it does, then...
        If Err.Number = 0 Then
            '...save each open PowerPoint file into the 'strSavePath' path and then close the file.
            strSavePath = "C:\MS_Office\PowerPoint\Test" 'Path where the open PowerPoint files are to be saved. Change to suit.
            strSavePath = IIf(Right(strSavePath, 1) <> "\", strSavePath & "\", strSavePath)
            For i = objPP_App.Presentations.Count To 1 Step -1
                Set objPP_Pres = objPP_App.Presentations(i)
                objPP_Pres.SaveAs strSavePath & objPP_Pres.Name
                objPP_Pres.Close
            Next i
        End If
    On Error GoTo 0
    
    Application.ScreenUpdating = True
    
End Sub

Regards,

Robert