开发者

Powerpoint Kiosk VBScript Updater

Using a script from The Scripting Guy Here I'm trying to create a simple presentation updater.

Scenario:

Windows XP Pro attached to the back of a big screen TV. It shares a folder "C:\share" and users connect to it and update a power point presentation "Master.ppsx." The PC looks at c:\share to see if there is an updated version of "Master.ppsx", if there is it

  • Closes the current presentation

  • Copies "Master.ppsx" from "c:\share" to "c:\presentations"

  • Presents the new presentation in "c:\presentations"

On Error Resume Next

Const ppAdvanceOnTime = 2   ' Run according to timings (not clicks)
Const ppShowTypeKiosk = 3   ' Run in "Kiosk" mode (fullscreen)
Const ppAdvanceTime = 5     ' Show each slide for 10 seconds

' Open the two power point files to work with them.
Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set CurrentPPT = objFileSys.GetFile("c:\presentations\Master.pptx")
Set NewPPT = objFileSys.GetFile("c:\share\Master.pptx")

' Open the shell object for passing commands.
Set objShell = CreateObject("WScript.Shell")

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

Set objPresentation = objPPT.Presentations.Open(currentPPT.Path)

' Apply powerpoint settings
objPresentation.Slides.Range.SlideShowTransition.AdvanceOnTime = TRUE
objPresentation.SlideShowSettings.AdvanceMode = ppAdvanceOnTime 
objPresentation.SlideShowSettings.ShowType = ppShowTypeKiosk
objPresentation.Slides.Range.SlideShowTransition.AdvanceTime = ppAdvanceTime
objPresentation.SlideShowSettings.LoopUntilStopped = True

' Run the slideshow
Set objSlideShow = objPresentation.SlideShowSettings.Run.View

Do Until Err <> 0

    If NewPPT.DateLastModified > CurrentPPT.DateLastModified Then
        objPresentation.Close
        objFileSys.CopyFile NewPPT, CurrentPPT, True
        Set objSlideShow = objPresentation.SlideShowSettings.Run.View

    End If

Loop

objPresentation.Saved = False
objPresentation.Close
objPPT.Quit

The If/Then statement is whats breaking currently. It will close the powerpoint being presented, and copy over the new presentation... but when it goes to present the new slideshow the script just dies.

2015 Edit - Adding current solution in full below for those with questions. Currently running on Win 7 Pro x64. PowerPoint 2010. I also have it minimizing after the powerpoint is presented and cycles through once, while a web page is viewed for a set period of time, then the powerpoint cycles again.

Option Explicit
' ============================================================================
' Title:        UpdatePPTX.vbs
' Updated:      4/9/2015
' Purpose:      Updates and presents the powerpoint presentation running on the break room presentation kiosk
' Reference:    Source: http://blogs.technet.com/b/heyscriptingguy/archive/2006/09/05/how-can-i-run-a-powerpoint-slide-show-from-a-script.aspx
' Script adapted from The Scripting Guy blog above.
' ============================================================================

' Set constants that control how Powerpoint behaves
Public Const ppAdvanceOnTime = 2            ' Advance using preset timers instead of clicks.
Public Const ppShowTypeKiosk = 3            ' Run in "Kiosk" mode (fullscreen)
Public Const ppAdvanceTime = 20             ' 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 slideshow when finished.

' File system manipulation
Public objFileSys 'as Object                ' Used to work with files in the file system.
Public CurrentPPT 'as Object                ' Used to store the current presentation powerpoint
Public NewPPT 'as Object                    ' Used to store the new presentation powerpoint

' Objects for Powerpoint manipulation.
Public objSlideShow 'as Object              ' The current slide show being presented.
Public objPresentation 'as Object           ' The current powerpoint open
Public objPPT 'as Object                    ' Powerpoint application

' Miscellaneous windows objects.
Public objShell 'as Object                  ' Used for batch scripting gbmailer notifications
Public objExplorer 'as Object               ' Used to control the position of Internet Explorer

' Open the two powerpoint files to work with them.
Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set CurrentPPT = objFileSys.GetFile("C:\Utilities\UpdatePPTX\Presentation\Master.pptm")
Set NewPPT = objFileSys.GetFile("C:\Utilities\UpdatePPTX\Share\Master.pptm")

' Open the shell object for passing commands.
Set objShell = CreateObject("WScript.Shell")
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

On Error Resume Next ' Exits the loop to cleanly close if error.
Do Until Err.Number <> 0

        ' Compare the two files to see if a new version has been uploaded.
        If NewPPT.DateLastModified > CurrentPPT.DateLastModified Then

                ' If a user is in the middle of an upload, wait so the file can be fully copied to the share
                WScript.Sleep(5000) 

                ' Get the newest powerpoint and present it.
                CopyNew()
                Notify()
        End If

    Present()
    ShowIE()

Loop

' Clean up memory and exit
objPresentation.Saved = True
objSlideShow.Exit
objPresentation.Close
objPPT.Quit

objPPT = Nothing
objPresentation = Nothing
objSlideShow = Nothing

WScript.Quit

' =============================================
'                  Functions
' =============================================

' =============================================
' CopyNew - Move updated presentation over to presentation folder.
' =============================================
Sub CopyNew()

    Dim pptFileName 'as String      'Holds the filename for the History file.

    ' Copy the powerpoint from C:\Utilities\UpdatePPTX\Share to C:\Utilities\UpdatePPTX\Presentation
    objFileSys.CopyFile NewPPT.Path, CurrentPPT.Path, True
    pptFileName = Year(Now()) & Month(Now()) & Day(Now()) & "_" & Hour(Now()) & "-" & Minute(Now())
    objFileSys.CopyFile NewPPT.Path, "C:\Utilities\UpdatePPTX\Share\History\" & pptFileName & ".pptm"

End Sub

' =============================================
' Notify - Send email when updated.
' =============================================
Sub Notify()
    ' This sub routine handles smtp email notifications
    ' Using GBMail send a notification to the people who do presentation updates
    ' objShell.Run "C:\Utilities\UpdatePPTX\Email\gbmailer\gbmail.exe -v -file C:\Utilities\UpdatePPTX\email.txt -from [from] -h [smtp] -to [To] -s Breakroom_Presentation_Updated", 0
End Sub

' =============================================
' Present PowerPoint
' =============================================
Sub Present()

        ' Establish the presentation object
        S开发者_JAVA百科et objPresentation = objPPT.Presentations.Open(CurrentPPT.Path)

        ' Apply powerpoint settings
        objPresentation.Slides.Range.SlideShowTransition.AdvanceOnTime = TRUE
        objPresentation.SlideShowSettings.AdvanceMode = ppAdvanceOnTime 
        objPresentation.SlideShowSettings.ShowType = ppShowTypeKiosk
        objPresentation.Slides.Range.SlideShowTransition.AdvanceTime = ppAdvanceTime
        ' objPresentation.SlideShowSettings.LoopUntilStopped = True

        ' Play the new slideshow
        Set objSlideShow = objPresentation.SlideShowSettings.Run.View

    ' Trap loop until the slide show is finished.
    Do until objSlideShow.State = ppSlideShowDone

        ' Make sure mouse stays hidden
       objPresentation.SlideShowWindow.View.PointerType = ppSlideShowPointerType

        ' Make sure PowerPoint is on top. (does nothing)
       If objShell.AppActivate("PowerPoint Slide Show - [Master.pptm") <> 1 Then
            objShell.AppActivate "PowerPoint Slide Show - [Master.pptm]"
        End If

        ' Make sure PowerPoint remains active so it can play (maintains focus).
       objPresentation.SlideShowWindow.Activate

        If Err <> 0 Then
            Exit Do
        End If

    Loop

    objSlideShow.Exit
    objPresentation.Saved = True
    objPresentation.Close

End Sub

' =============================================
' Show IE
' =============================================
Sub ShowIE()

    Dim colProcesses : Set colProcesses = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery( "Select * From Win32_Process" )
    Dim objProcess
    Dim intRunning
    Dim objItem

    ' Look through all processes currently running, check if Internet Explorer is running.
    intRunning = 0
    For Each objProcess in colProcesses
        If objProcess.Name = "iexplore.exe" Then
            intRunning = 1
        End If
    Next

    ' If not running, launch it in full screen and show the KDT Realtime app.
    If intRunning = 0 Then

        Set objExplorer = WScript.CreateObject("InternetExplorer.Application")
        objExplorer.Navigate "paste url here"
        objExplorer.Visible = True
        objExplorer.FullScreen = True
        objExplorer.StatusBar = False

        ' Wait 5 seconds for IE to load before applying zoom setting.
        Wscript.Sleep 5000

        ' Modify zoom to desired level.
        ' Can be removed modified based on resolution / screen size
        objExplorer.Document.Body.Style.Zoom = "150%"

    End If

    ' Make sure IE is on top.
    CreateObject("WScript.Shell").AppActivate objExplorer.document.title
    objExplorer.Visible = True

    ' Show IE for 10 minutes by pausing script.
    WScript.Sleep 600000

    ' Hide IE so the powerpoint can play.
    objExplorer.Visible = False

End Sub


I'm not a vbscripter but I think I see the problem.

If NewPPT.DateLastModified > CurrentPPT.DateLastModified Then
    objPresentation.Close
    objFileSys.CopyFile NewPPT, CurrentPPT, True

' you've closed objPresentation at this point; it no longer exists ' but next you:

    Set objSlideShow = objPresentation.SlideShowSettings.Run.View

' which won't fly, because there IS no objPresentation object.

You'll need to do this bit again first; open the new presentation and get a reference to it, set up the show params and THEN you can do the .Run.View trick

Set objPresentation = objPPT.Presentations.Open(currentPPT.Path)

' Apply powerpoint settings objPresentation.Slides.Range.SlideShowTransition.AdvanceOnTime = TRUE objPresentation.SlideShowSettings.AdvanceMode = ppAdvanceOnTime objPresentation.SlideShowSettings.ShowType = ppShowTypeKiosk objPresentation.Slides.Range.SlideShowTransition.AdvanceTime = ppAdvanceTime objPresentation.SlideShowSettings.LoopUntilStopped = True

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜