How to apply this VBA to multiple PPT files in a folder

Question

I would like this particular code to be run on multiple powerpoint files in a folder. But it would be even better if it would open the powerpoint file, run this code below, save it and then open the next one. Any suggestions are welcome! I have been through code on this website, but can't seem to adapt it to my code below (e.g. this one Loop through files in a folder using VBA?)

LOOPING ATTEMPT

flag

Sub LoopThroughFiles() 
Dim MyObj As Object, MySource As Object, file As Variant 
file = Dir("c:\testfolder\") 
While (file <> "") 
   If InStr(file, "test") > 0 Then 
          MsgBox "found " & file 
          Exit Sub 
    End If 
file = Dir 
Wend 
End Sub  

Existing Code

Option Explicit

' Selects the shape that support text which is closest to the top of the slide
' Written by Jamie Garroch of YOUpresent Ltd (http://youpresent.co.uk)
Sub SelectHigestTextShape()
  Dim oSld As Slide
  Dim oShp As Shape, oShpTop As Shape
  Dim sShpTop As Single

  On Error Resume Next
  Set oSld = ActiveWindow.View.Slide
  If Err Then Exit Sub
  On Error GoTo 0

  ' Set the top to the bottom of the slide
  sShpTop = ActivePresentation.PageSetup.SlideHeight

  ' Check each shape on the slide is positioned above the stored position
  ' Shapes not supporting text and placeholders are ignored
  For Each oShp In oSld.Shapes
    If oShp.Top < sShpTop And oShp.HasTextFrame And Not oShp.Type = msoPlaceholder Then
      sShpTop = oShp.Top
      Set oShpTop = oShp
    End If
  Next

  ' Select the topmost shape
  If Not oShpTop Is Nothing Then oShpTop.Select msoTrue
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
  ' Clean up
  Set oSld = Nothing
  Set oShp = Nothing
  Set oShpTop = Nothing
End Sub

Answer 1

That's my code sample for the SelectHigestTextShape sub but I'm not sure it'll work the way you want for multiple files. The reason is that it was designed to SELECT a textbox object within the ACTIVE PRESENTATION using the ACTIVE VIEW. None of this exists when you loop through files in a folder as you'd need to open each one in turn but even then, what would be the point of selecting a shape only to close the presentation afterwards? I guess we really need to know the end goal. In the type of batch processing you're attempting, it would not be a good idea to select anything at all as that requires the object's view to be active which is a debugging nightmare and slows everything down a lot. If you want to do something with a particular object, it's much better to use a reference to it without requiring an active view or even an active window (you could open each file invisibly, process it and then close it).

This example will loop through a folder, open each presentation it finds (without a window), loop through all shapes on all slides, output a count of slides and shapes to the immediate pane, and then close the file:

' Loop through all PowerPoint files in a specified folder
' Open each and then loop through each shape of each slide
' Output a count of slides and shapes in immediate pane before closing the file
' Modified by Jamie Garroch of YOUpresent Ltd (http://youpresent.co.uk)
Sub LoopThroughPPTFiles()
  Dim oPres As Presentation, oSld As Slide, oShp As Shape
  Dim SldCount As Long, ShpCount As Long
  Dim MyFile As String
  Const MyFolder = "c:\testfolder\"
  On Error GoTo errorhandler
  MyFile = Dir(MyFolder)
  While (MyFile <> "")
    If Right(MyFile, 5) Like ".ppt*" Then
      Set oPres = Presentations.Open(FileName:=MyFolder & MyFile, ReadOnly:=msoTrue, Untitled:=msoFalse, WithWindow:=msoFalse)
      For Each oSld In oPres.Slides
        SldCount = SldCount + 1
        For Each oShp In oSld.Shapes
          ShpCount = ShpCount + 1
        Next
      Next
      Debug.Print oPres.Name & " has " & SldCount & " slide(s) and " & ShpCount & " shapes."
      SldCount = 0: ShpCount = 0
      oPres.Close
    End If
    MyFile = Dir
  Wend
  ' clean up
  Set oPres = Nothing: Set oSld = Nothing: Set oShp = Nothing
  Exit Sub
errorhandler:
  If Not oPres Is Nothing Then oPres.Close: Set oPres = Nothing
End Sub

You could use this to then examine the shapes after the "For Each oShp In oSld.Shapes" line to find the one positioned highest on the slide and then process it (without selecting it).