VB Script Do Loop errors

[JonathanMoore]

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:

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

Loop

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:

 Sub getSubFolder(pCurrentDir)

Does anyone have any ideas about how I can get this to loop indefinitely?

Thanks very much!
Jon