Extrahieren Sie alle Text aus einer Powerpoint-Datei in VBA

Question

Ich habe eine riesige Menge von Powerpoint-Dateien, aus denen ich alle um den Text zu extrahieren und Klumpen einfach alles in eine große Textdatei. Jede Quelle (PPT) Datei hat mehrere Seiten (Dias). Ich kümmere mich nicht um die Formatierung -. Nur die Worte

Ich kann dies mit einer Datei manuell tun, indem nur ^ A ^ C in PPT, gefolgt von ^ V im Notizblock; dann Seite nach unten in der PPT, und wiederholen Sie für jede Folie in der Powerpoint. (Schade, kann ich nicht nur ein ^ A tun, dass alles packen würde ... dann könnte ich SendKey zum Kopieren / Einfügen)

Aber es gibt viele Hunderte dieser PPTs mit einer unterschiedlichen Anzahl von Dias.

Es ist wie das scheint eine gemeinsame Sache wäre tun zu möchte, aber ich kann nicht ein Beispiel überall finden.

Hat jemand Beispielcode, dies zu tun?

Answer 1

Hier ist ein Code, den Sie, um loszulegen. Diese Dumps den gesamten Text in Folien zu dem Debug-Fenster. Es versucht nicht, zu Format, Gruppe oder irgendetwas tun, andere als nur Müllkippe.

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

Das folgende Beispiel zeigt Code-Schleife durch eine Liste von Dateien basierend auf Otaku Code gegeben oben:

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