VBA for opening and editing multiple Powerpoint files - vba

Question

I have a folder with over 200 Powerpoint files and I have been have been struggling with a Macro that opens each of these files, edits them, saves them and closes them in a loop.
I have managed to create code for the editing part, however I can't manage to create a code that picks each of the files in the folder. Using "*.pptx" doesn't seem to work and writing code with a specific filename for each of these files is very inefficient.
Does anyone have a solution to this?
Sub SaveNotesText()
Dim oPres As Presentation
Dim oSlides As Slides
Dim oSlide As Slide
Dim oShapes As Shapes
Dim oSh As Shape
Dim NotesText As String
Dim FileNum As Integer
Dim PathSep As String
#If Mac Then
PathSep = ":"
#Else
PathSep = "\"
#End If
Set oPres = ActivePresentation
Set oSlides = oPres.Slides
For Each oSlide In oSlides
NotesText = NotesText & "Slide " & oSlide.SlideIndex & vbCrLf
Set oShapes = oSlide.NotesPage.Shapes
For Each oSh In oShapes
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
NotesText = NotesText & oSh.TextFrame.TextRange.Text
End If
End If
Next oSh
NotesText = NotesText & vbCrLf
Next oSlide
FileNum = FreeFile
Open oPres.Path & PathSep & "NotesText.TXT" For Output As FileNum
Print #FileNum, NotesText
Close FileNum
End Sub
http://www.pptfaq.com/FAQ00274.htm

Answer 1

You can use Dir to loop through all the "#.ppt#" files in a folder, ie
Public Sub DoFiles()
Dim strFileName As String
Dim strFolderName As String
Dim PP As Presentation
'set default directory here if needed
strFolderName = "C:\temp"
strFileName = Dir(strFolderName & "\*.ppt*")
Do While Len(strFileName) > 0
Set PP = Presentations.Open(strFolderName & "\" & strFileName)
'your code
PP.Close
strFileName = Dir
Loop
End Sub