【发布时间】：2015-12-16 23:13:09
【问题描述】：
使用来自 The Scripting Guy Here 的脚本我正在尝试创建一个简单的演示文稿更新程序。
场景：
安装在大屏幕电视背面的 Windows XP Pro。它共享一个文件夹“C:\share”，用户连接到它并更新一个PowerPoint演示文稿“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
【问题讨论】：
标签： vbscript powerpoint