Extracting all text from a powerpoint file in VBA

前端 未结 2 510
南旧
南旧 2020-12-11 06:36

I have a huge set of powerpoint files from which I want to extract all the text and just lump it all into one big text file. Each source (PPT) file has multiple pages (slid

相关标签:
2条回答
  • 2020-12-11 06:56

    The following example shows code to loop through a list of files based on Otaku's code given 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
    
    0 讨论(0)
  • 2020-12-11 07:02

    Here's some code to get you started. This dumps all text in slides to the debug window. It doesn't 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
    
    0 讨论(0)
提交回复
热议问题