Hi All,
I've got the following code that run's one PowerPoint presentation, closes it down, searches through a specified folder structure for another presentation - runs it if there is one there and does nothing if there isn't one:
Now, I've included an infinity loop so this process should continue all day. However, when i try and run it with the loop in it the current place, I get a syntax error on the following line:
Does anyone have any ideas about how I can get this to loop indefinitely?
Thanks very much!
Jon
I've got the following code that run's one PowerPoint presentation, closes it down, searches through a specified folder structure for another presentation - runs it if there is one there and does nothing if there isn't one:
Code:
Do
On Error Resume Next
Const ppAdvanceOnTime = 2
Const ppShowTypeKiosk = 3
Const ppSlideShowDone = 5
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Open("S:\common\AV Screens\JonTest.ppt")
objPresentation.Slides.Range.SlideShowTransition.AdvanceOnTime = TRUE
objPresentation.SlideShowSettings.AdvanceMode = ppAdvanceOnTime
objPresentation.SlideShowSettings.ShowType = ppShowTypeKiosk
objPresentation.SlideShowSettings.StartingSlide = 1
objPresentation.SlideShowSettings.EndingSlide = objPresentation.Slides.Count
Set objSlideShow = objPresentation.SlideShowSettings.Run.View
Do Until objSlideShow.State = ppSlideShowDone
If Err <> 0 Then
Exit Do
End If
Loop
objPresentation.Saved = True
objPresentation.Close
set objPresentation = Nothing
Dim objFSO, objFolder, sPath
Set objFSO = CreateObject("Scripting.FileSystemObject")
sPath = "S:\common\AV Screens\BIA"
Set objFolder = objFSO.GetFolder(sPath)
getPPTFiles objFolder
getSubFolder objFolder
Sub getSubFolder(pCurrentDir)
For Each bItem In pCurrentDir.SubFolders
getPPTFiles bItem
Next
End Sub
Sub getPPTFiles(myFolder)
For Each PPTFile in myFolder.Files
myFile = myFolder + "\" + PPTFile.Name
If LCase(objFSO.GetExtensionName(myFile)) = "ppt" Then
'Wscript.Echo "PPT_Path - " & myFile
RunPPTShow myFile
End If
Next
End Sub
Sub RunPPTShow(PPT_Path)
On Error Resume Next
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Open(PPT_Path)
objPresentation.Slides.Range.SlideShowTransition.AdvanceOnTime = TRUE
objPresentation.SlideShowSettings.AdvanceMode = ppAdvanceOnTime
objPresentation.SlideShowSettings.ShowType = ppShowTypeKiosk
objPresentation.SlideShowSettings.StartingSlide = 1
objPresentation.SlideShowSettings.EndingSlide = objPresentation.Slides.Count
Set objPPT = objPresentation.SlideShowSettings.Run.View
Do Until objPPT.State = ppSlideShowDone
If Err <> 0 Then
Exit Do
End If
Loop
objPresentation.Saved = True
objPresentation.Close
set objPresentation = Nothing
End Sub
LoopCode:
Sub getSubFolder(pCurrentDir)Thanks very much!
Jon