Extraer todo el texto de un archivo de PowerPoint en VBA

Question

Tengo un enorme conjunto de archivos de PowerPoint de la que desea extraer todo el texto y apenas agrupar todo en un archivo de texto grande. Cada archivo de origen (PPT) tiene varias páginas (diapositivas). No me importa acerca del formato -. Sólo las palabras

I podía hacer esto manualmente con un archivo con sólo ^ A ^ C en PPT, seguido de ^ V en libreta; luego hacia abajo la página en el PPT, y repita para cada diapositiva de PowerPoint. (Lástima que no se acaba de hacer una ^ A que agarrar TODO ... entonces yo podría utilizar sendKey a copiar / pegar)

Pero hay muchos cientos de estos PPT con diferente número de diapositivas.

Parece que esto sería una cosa normal que desee hacer, pero no puede encontrar un ejemplo en cualquier lugar.

¿alguien tiene código de ejemplo para hacer esto?

Answer 1

Aquí hay un código para que pueda empezar. Este vertederos de todo el texto en las diapositivas de la ventana de depuración. No trata a formato, grupo o hacer que no sea sólo volcado nada.

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

El siguiente código de ejemplo se muestra a bucle a través de una lista de archivos basado en el código de Otaku dado anteriormente:

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