Extrahieren Sie alle Text aus einer Powerpoint-Datei in VBA
-
10-10-2019 - |
Frage
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?
Lösung
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
Andere Tipps
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