Extract all text from a PowerPoint file in VBA

Question

I have a huge set of powerpoint files from which I want to extract all the text and simply put it in one large text file. Each source file (PPT) has several pages (slides). I'm not interested in formatting - just words.

I could do it manually using a file only ^ A ^ C in PPT followed by ^ V in notepad; then scroll down the page in PPT and repeat for each slide in PowerPoint. (Too bad, I can't just make a ^ A that would capture EVERYTHING ... then I could use sendkey to copy / paste)

But there are many hundreds of these PPTs with different numbers of slides.

It seems like this would be a common task, but I can't find an example anywhere.

Does anyone have sample code for this?

Answer 1

Here is the code to get you started. This throws all the text in the slides to the debug window. He does not try to format, group, or do anything other than just dump.

Sub GetAllText()
Dim p As Presentation: Set p = ActivePresentation
Dim s As Slide
Dim sh As Shape
For Each s In p.Slides
    For Each sh In s.Shapes
        If sh.HasTextFrame Then
            If sh.TextFrame.HasText Then
                Debug.Print sh.TextFrame.TextRange.Text
            End If
        End If
    Next
Next
End Sub

Answer 2

The following example shows the code to loop through a list of files based on the Otaku code above:

Sub test_click2()

Dim thePath As String
Dim src As String
Dim dst As String
Dim PPT As PowerPoint.Application
Dim p As PowerPoint.Presentation
Dim s As Slide
Dim sh As PowerPoint.Shape
Dim i As Integer
Dim f(10) As String

f(1) = "abc.pptx"
f(2) = "def.pptx"
f(3) = "ghi.pptx"

thePath = "C:\Work\Text parsing PPT\"

For i = 1 To 3
  src = thePath & f(i)
  dst = thePath & f(i) & ".txt"

  On Error Resume Next
  Kill dst
  Open dst For Output As #1
    Set PPT = CreateObject("PowerPoint.Application")
    PPT.Activate
    PPT.Visible = True
    'PPT.WindowState = ppWindowMinimized
    PPT.Presentations.Open filename:=src, ReadOnly:=True
    For Each s In PPT.ActivePresentation.Slides
        For Each sh In s.Shapes
            If sh.HasTextFrame Then
                If sh.TextFrame.HasText Then
                    Debug.Print sh.TextFrame.TextRange.Text
                End If
            End If
        Next
    Next
    PPT.ActivePresentation.Close
  Close #1
Next i
Set PPT = Nothing

End Sub