So I have around 1000 powerpoint slideshows (*.pps) that run in Speaker mode which we use as documentation.
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:
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
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