Extract Text from Powerpoint to Excel

Question

I need to extract some text from powerpoint into excel, it's for a work thing. I could do it manually but I am sure there is a much better and faster way.

I do not actually code, I did do some classes in python and VBA but I am not really proficient in it. I found some code online sigma code and tried to run it, there's an error in that the user-defined type being undefined.

Could someone take a look at the file and point me in the right direction? If I could just extract and send each text box into separate columns in the excel file, that would be great.

'Declare our Variables
Dim PPTPres As Presentation
Dim PPTSlide As Slide
Dim PPTShape As Shape
Dim PPTTable As Table
Dim PPTPlaceHolder As PlaceholderFormat

'Declare Excel Variables.
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWrkSheet As Excel.Worksheet
Dim xlRange As Excel.Range

'Grab the Currrent Presentation.
Set PPTPres = Application.ActivePresentation
                     
    'Keep going if there is an error
    On Error Resume Next
    
    'Get the Active instance of Outlook if there is one
    Set xlApp = GetObject(, "Excel.Application")
    
        'If Outlook isn't open then create a new instance of Outlook
        If Err.Number = 429 Then
        
            'Clear Error
            Err.Clear
        
            'Create a new Excel App.
            Set xlApp = New Excel.Application
            
                'Make sure it's visible.
                xlApp.Visible = True
            
            'Add a new workbook.
            Set xlBook = xlApp.Workbooks.Add
            
            'Add a new worksheet.
            Set xlWrkSheet = xlBook.Worksheets.Add
    
        End If
    
    'Set the Workbook to the Active one, if Excel is already open. THIS ASSUMES WE HAVE A WORKBOOK IN THE EXCEL APP.
    Set xlBook = xlApp.Workbooks("ExportFromPowerPointToExcel.xlsm")
    
    'Set the Worksheet to the Active one, if Excel is already open. THIS ASSUMES WE HAVE A WORKSHEET IN THE WORKBOOK.
    Set xlWrkSheet = xlBook.Worksheets("Slide_Export")
    
    'Loop through each Slide in the Presentation.
    For Each PPTSlide In PPTPres.Slides
    
        'Loop through each Shape in Slide.
        For Each PPTShape In PPTSlide.Shapes
            
            'If the Shape is a Table.
            If PPTShape.Type = msoPlaceholder Or PPTShape.Type = ppPlaceholderVerticalObject Then
                
                'Grab the Last Row.
                Set xlRange = xlWrkSheet.Range("A100000").End(xlUp)

                'Handle the loops that come after the first, where we need to offset.
                If xlRange.Value <> "" Then

                    'Offset by One rows.
                    Set xlRange = xlRange.Offset(1, 0)

                End If

                'Grab different Shape Info and export it to Excel.
                xlRange.Value = PPTShape.TextFrame.TextRange
                xlRange.Offset(0, 1).Value = PPTSlide.Name
                xlRange.Offset(0, 2).Value = PPTSlide.SlideIndex
                xlRange.Offset(0, 3).Value = PPTSlide.Layout
                xlRange.Offset(0, 4).Value = PPTShape.Name
                xlRange.Offset(0, 5).Value = PPTShape.Type
                
            End If
            
        Next
    Next

    'Set the Worksheet Column Width.
    xlWrkSheet.Columns.ColumnWidth = 20
    
    'Set the Worksheet Row Height.
    xlWrkSheet.Rows.RowHeight = 20
    
    'Set the Horizontal Alignment so it's to the Left.
    xlWrkSheet.Cells.HorizontalAlignment = xlLeft
    
    'Turn off the Gridlines.
    xlApp.ActiveWindow.DisplayGridLines = False

End Sub

Answer 1

Your user-defined error is probably because you haven't added a reference to the Excel Object Library using Tools->References. This macro runs in the PPTM file and doesn't need the reference as it uses late binding. It exports to new workbook text boxes only, one row for each slide.

Option Explicit

Sub ExportToExcel()

    'Declare variables
    Const WB_NAME = "ExportFromPowerPointToExcel.xlsx"
    Const WS_NAME = "Slide_Export"
   
    Dim PPTPres As Presentation, PPTSlide As Slide, PPTShape As Shape
    Dim PPTTable As Table
    Dim PPTPlaceHolder As PlaceholderFormat

    ' create workbook
    Dim xlApp, wb, ws
    Set xlApp = CreateObject("Excel.Application")
    Dim iRow As Long, c As Integer, folder As String
    
    'Set xlApp = New Excel.Application
    xlApp.Visible = True

    Set wb = xlApp.Workbooks.Add
    Set ws = wb.Worksheets(1)
    ws.Name = WS_NAME
    iRow = 2

    'Grab the Currrent Presentation.
    Set PPTPres = Application.ActivePresentation

    'Loop through each Slide in the Presentation.
    For Each PPTSlide In PPTPres.Slides
    
        'Loop through each Shape in Slide.
        For Each PPTShape In PPTSlide.Shapes
            If PPTShape.HasTextFrame Then
                c = PPTShape.Id + 1
                ' headings
                If ws.Cells(1, c) = "" Then
                   ws.Cells(1, c) = PPTShape.Name
                End If
                ws.Cells(iRow, c) = PPTShape.TextFrame.TextRange
            End If
        Next
        ws.Cells(iRow, 1) = PPTSlide.Name
        iRow = iRow + 1

    Next

    With ws
        .Columns.ColumnWidth = 20
        .Rows.RowHeight = 20
        .Columns.HorizontalAlignment = xlLeft
    End With
    xlApp.ActiveWindow.DisplayGridLines = False

    ' save
    folder = PPTPres.Path & "\"
    xlApp.DisplayAlerts = False
    wb.SaveAs folder & WB_NAME
    xlApp.DisplayAlerts = True
    wb.Close False

    ' quit excel
    xlApp.Quit
    Set xlApp = Nothing

    MsgBox "File saved to " & folder & WB_NAME
End Sub