Search code examples
batch-filecmdpowerpointbulkpowerpoint-2010

Batch convert powerpoint slideshows to kiosk


So I have around 1000 powerpoint slideshows (*.pps) that run in Speaker mode which we use as documentation.

Speaker mode

I want to prohibit the user to scroll forwards and backwards manually and only close the slideshow with the ESC key. This is where kiosk mode fits perfectly. So I need to convert all those files to kiosk mode and I rather wouldn't do it manually. I've already checked for a solution, all I've found was an old PowerPoint Viewer command "/K". http://www.pptfaq.com/FAQ00528_Command_Line_Switches_-_PowerPoint_and_PowerPoint_Viewers.htm

Another option was to use PowerPoint Viewer, but since there's no way to open slideshows in kiosk mode by default, this option also fails.

I really hope someone knows a solution or can put me in the right direction.

UPDATE 1:

@Steve Rindsberg Thanks for your help, I have combined your code with the one found here: http://www.pptalchemy.co.uk/file_scripting.html

It now looks like this:

Sub getfiles(strpath As String)
    Dim PPT As PowerPoint.Application
    Dim fso As Object
    Dim objfolder As Object
    Dim objfile As Object
    Dim opres As PowerPoint.Presentation
    Dim strSuffix As String
    Dim objsub As Object
    strSuffix = "*.pp*" 'File suffix note * is wild card
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objfolder = fso.GetFolder(strpath)
     ' main folder
    For Each objfile In objfolder.Files
        If objfile.Name Like strSuffix Then
            Set PPT = New PowerPoint.Application
            Set opres = PPT.Presentations.Open(objfile.Path, msoFalse)
             If objfile.Name Like "*.pps*" Then
                opres.NewWindow
             End If

            opres.SlideShowSettings.ShowType = ppShowTypeKiosk
            opres.Save
            opres.Close
            PPT.Quit
        End If
    Next objfile
     ' Sub Folders
    For Each objsub In objfolder.SubFolders
        Call getfiles(objsub.Path)
    Next objsub

    Set objsub = Nothing
    Set objfile = Nothing
    Set objfolder = Nothing
    Set opres = Nothing
    Set PPT = Nothing
End Sub

The first file found works just ok, the second file gives me the following error message: Error message
And the debugger highlights on the line: opres.SlideShowSettings.ShowType = ppShowTypeKiosk. I know the problem is the opres part, just can't seem to figure out what the solution is.

UPDATE 2: Figured it out :D. I've build in a statement to see if the Powerpoint.Application already exists and now it works flawlessly. Though suggestions are always welcome, for me the question is now closed. Thanks for the help

My final code:

Sub getfiles(strpath As String)
    Dim PPT As PowerPoint.Application
    Dim fso As Object
    Dim objfolder As Object
    Dim objfile As Object
    Dim opres As PowerPoint.Presentation
    Dim strSuffix As String
    Dim objsub As Object
    strSuffix = "*.pp*" 'File suffix note * is wild card
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objfolder = fso.GetFolder(strpath)
     ' main folder
    For Each objfile In objfolder.Files
        If objfile.Name Like strSuffix Then
            If PPT Is Nothing Then
                Set PPT = New PowerPoint.Application
            Else
            End If
            Set opres = PPT.Presentations.Open(objfile.Path, msoFalse)
             If objfile.Name Like "*.pps*" Then
                opres.NewWindow
             End If

            opres.SlideShowSettings.ShowType = ppShowTypeKiosk
            opres.Save
            opres.Close

        End If
    Next objfile
     ' Sub Folders
    For Each objsub In objfolder.SubFolders
        Call getfiles(objsub.Path)
    Next objsub

    Set objsub = Nothing
    Set objfile = Nothing
    Set objfolder = Nothing
    Set opres = Nothing
    Set PPT = Nothing
End Sub

Solution

  • I suspect you can automate this. In outline, using VBA, you'd:

    Open each presentation, then

    With ActivePresentation.SlideShowSettings
        .ShowType = ppShowTypeKiosk
    End With
    With ActivePresentation
       .Save
       .Close
    End With
    

    If you're automating PPT externally, ppShowTypeKiosk = 3