Extrahieren aller Texte aus einer PowerPoint-Datei in VBA

Question

Ich habe eine große Menge von PowerPoint-Dateien, aus denen ich den ganzen Text extrahieren und alles in eine große Textdatei zusammenfassen möchte. Jede Quelldatei (PPT) hat mehrere Seiten (Folien). Ich kümmere mich nicht um Formatierung - nur die Wörter.

Ich könnte dies manuell mit einer Datei durch nur^A^C in PPT, gefolgt von^V in Notepad; dann blättern Sie in der PPT nach unten und wiederholen Sie diese Schritte für jede Folie im PowerPoint. (Schade, ich kann nicht einfach ein^A machen, das ALLES ergreift ... dann könnte ich sendkey zum Kopieren/Einfügen verwenden)

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

Es scheint, als ob dies eine gemeinsame Sache wäre, aber ich kann nirgends ein Beispiel finden.

Hat jemand einen Beispielcode, um dies zu tun?

Answer 1

Hier ist ein Code, um loszulegen. Dadurch wird der gesamte Text in den Folien in das Debug-Fenster kopiert. Es wird nicht versucht, etwas zu formatieren, zu gruppieren oder etwas anderes zu tun, als nur abzuladen.

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 durch eine Liste von Dateien in einer Schleife basierend auf Code des Otaku oben gegeben:

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