Powerpoint Kiosk VBScript 更新程序

Question

使用脚本专家 这里 我正在尝试创建一个简单的演示文稿更新程序。

场景：
Windows XP Pro 连接到大屏幕电视的背面。它共享一个文件夹“C:\share”，用户连接到该文件夹​​并更新 Power Point 演示文稿“Master.ppsx”。 PC 查看 c:\share 是否有“Master.ppsx”的更新版本，如果有则

• 关闭当前演示文稿
  
• 将“Master.ppsx”从“c:\share”复制到“c” :\presentations"
  
• 在“c:\presentations”中呈现新的演示文稿

，错误继续下一步

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

If/Then 语句是当前中断的内容。它将关闭正在演示的幻灯片，并复制新的演示文稿......但是当它演示新的幻灯片时，脚本就会死掉。

2015 编辑 - 在下面完整添加当前解决方案，以供有疑问的人使用。目前在 Win 7 Pro x64 上运行。 PowerPoint 2010。在演示幻灯片并循环播放一次后，我还会将其最小化，而在查看网页一段时间后，幻灯片会再次循环。

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
        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

        ' 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

Answer 1

我不是 vbscripter，但我想我看到了问题所在。

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

' 此时您已经关闭了 objPresentation；它不再存在
' 但接下来你：

    Set objSlideShow = objPresentation.SlideShowSettings.Run.View

' 它不会飞，因为没有 objPresentation 对象。

您需要先再次执行此操作；打开新演示文稿并获取对其的引用，设置显示参数，然后您可以执行 .Run.View 技巧

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

' 应用 powerpoint 设置
objPresentation.Slides.Range.SlideShowTransition.AdvanceOnTime = TRUE
objPresentation.SlideShowSettings.AdvanceMode = ppAdvanceOnTime
objPresentation.SlideShowSettings.ShowType = ppShowTypeKiosk
objPresentation.Slides.Range.SlideShowTransition.AdvanceTime = ppAdvanceTime
objPresentation.SlideShowSettings.LoopUntilStopped = True