KioskPPT.vbs

Option Explicit

' Title:        kioskPPT.vbs
' Author:       Alex Paarfus <[email protected]>
' Date:         2018-03-07
' Based On:     https://tinyurl.com/ybwl2fdp

' Var/Const definitions
Public Const ppAdvanceOnTime = 2            ' Advance using preset timers
Public Const ppShowTypeKiosk = 3            ' Run in "Kiosk" mode: Fullscreen looped
Public Const ppAdvanceTime = 2              ' Amount of time, in seconds, that each slide will be shown
Public Const ppSlideShowPointerType = 4     ' Hide the mouse cursor
Public Const ppSlideShowDone = 5            ' State of the slideshown when finished

Public objFSO                               ' Used to work with Files in the File System
Public objPPTCur                            ' Used to store the Current Powerpoint file
Public objPPTNew                            ' Used to store the New/Updated Powerpoint file

Public objShow                              ' The Current slide show being presented
Public objPres                              ' The current powerpoint that's open
Public objPPT                               ' The powerpoint application itself

' Open the two files to work with them
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objPPTCur = objFSO.GetFile("Path\To\Current.ppt")
Set objPPTNew = objFSO.GetFile("Path\To\New.ppt")

' Open the PPT Application
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True                       ' Make the Powerpoint application Visible

' -- Start Run -- '
On Error Resume Next                        ' Exits the loop to cleanly close if an error occurs
Do Until Err.Number <> 0
    ' Compare mtime for both files; if update is newer, then update
    If objPPTNew.DateLastModified > objPPTCur.DateLastModified Then
        WScript.Sleep(5000)                 ' Wait for the file to finish saving (5s)
        CopyNew()                           ' Update objPPTCur with objPPTNew
    End If
    Present()                               ' Present objPPTCur
Loop

' Clean up memory and exit
objPres.Saved = True
objShow.Exit
objPres.Close
objPPT.Quit

objPPT = Nothing
objPres = Nothing
objShow = Nothing

WScript.Quit
' -- End Run -- '

' Functions
' CopyNew - Move updated presentation to presentation folder
Sub CopyNew()
    Dim pptFileName

    ' Update objPPTCur with objPPTNew
    objFSO.CopyFile objPPTNew.Path, objPPTCur.Path, True

    ' Add a backup file to M:\ConfSlideShow\History with Filename = YYYY-M-D_HH-MM.ppt
    pptFileName = Year(Now()) & "-" & Month(Now()) & "-" & Day(Now()) & "_" & Hour(Now()) & "-" & Minute(Now())
    objFSO.CopyFile objPPTNew.Path, "Path\To\History\" & pptFileName & ".ppt"
End Sub

' Present -- Present the PowerPoint Presentation
Sub Present()
    Set objPres = objPPT.Presentations.Open(objPPTCur.Path)

    ' Apply configurations, based on above Consts
    objPres.Slides.Range.SlideShowTransition.AdvanceOnTime = TRUE
    objPres.SlideShowSettings.AdvanceMode = ppAdvanceOnTime
    objPres.SlideShowSettings.ShowType = ppShowTypeKiosk
    objPres.Slides.Range.SlideShowTransition.AdvanceTime = ppAdvanceTime
    objPres.SlideShowSettings.LoopUntilStopped = True

    ' Display the Slideshow
    Set objShow = objPres.SlideShowSettings.Run.View

    ' Trap Loop: runs until SlideShow is in the "Done" state
    Do until objShow.State = ppSlideShowDone
        objPres.SlideShowWindow.View.PointerType = ppSlideShowPointerType
        objPres.SlideShowWindow.Activate

        ' Exception Handler -- If an error occurs, exit the trap loop
        If Err <> 0 Then
            Exit Do
        End If

        ' File Update Check--same as above, but just to force an update
        If objPPTNew.DateLastModified > objPPTCur.DateLastModified Then
            Exit Do
        End If
    Loop
    objShow.Exit
    objPres.Saved = True
    objPres.Close
End Sub