Export Text to a text file, extract text from PowerPoint (Mac or PC)
This works on PC or Mac.
It saves the text from every shape on your notes pages to a file called NotesText.TXT in the same folder as the PowerPoint presentation itself.
Note: The code below won't work if you need to export non-roman text (ie, Hebrew, Arabic, various Asian languages) to a text file, but StackExchange user Minimus Heximus has posted a simple modification that'll work in this situation.
You'll find the code and the explanation here
Sub SaveNotesText() Dim oPres As Presentation Dim oSlides As Slides Dim oSlide As Slide Dim oShapes As Shapes Dim oSh As Shape Dim NotesText As String Dim FileNum As Integer Dim PathSep As String #If Mac Then PathSep = ":" #Else PathSep = "\" #End If Set oPres = ActivePresentation Set oSlides = oPres.Slides For Each oSlide In oSlides NotesText = NotesText & "Slide " & oSlide.SlideIndex & vbCrLf Set oShapes = oSlide.NotesPage.Shapes For Each oSh In oShapes If oSh.HasTextFrame Then If oSh.TextFrame.HasText Then NotesText = NotesText & oSh.TextFrame.TextRange.Text End If End If Next oSh NotesText = NotesText & vbCrLf Next oSlide FileNum = FreeFile Open oPres.Path & PathSep & "NotesText.TXT" For Output As FileNum Print #FileNum, NotesText Close FileNum End Sub
Here's a macro from Kris Lander that will export all the text on each slide in a presentation
I've modified it a bit to make it work on Macs and to distinguish between title, subtitle, body and other text.
Sub ExportText() Dim oPres As Presentation Dim oSlides As Slides Dim oSld As Slide 'Slide Object Dim oShp As Shape 'Shape Object Dim iFile As Integer 'File handle for output iFile = FreeFile 'Get a free file number Dim PathSep As String Dim FileNum As Integer #If Mac Then PathSep = ":" #Else PathSep = "\" #End If Set oPres = ActivePresentation Set oSlides = oPres.Slides FileNum = FreeFile 'Open output file ' NOTE: errors here if file hasn't been saved Open oPres.Path & PathSep & "AllText.TXT" For Output As FileNum For Each oSld In oSlides 'Loop thru each slide For Each oShp In oSld.Shapes 'Loop thru each shape on slide 'Check to see if shape has a text frame and text If oShp.HasTextFrame And oShp.TextFrame.HasText Then If oShp.Type = msoPlaceholder Then Select Case oShp.PlaceholderFormat.Type Case Is = ppPlaceholderTitle, ppPlaceholderCenterTitle Print #iFile, "Title:" & vbTab & oShp.TextFrame.TextRange Case Is = ppPlaceholderBody Print #iFile, "Body:" & vbTab & oShp.TextFrame.TextRange Case Is = ppPlaceholderSubtitle Print #iFile, "SubTitle:" & vbTab & oShp.TextFrame.TextRange Case Else Print #iFile, "Other Placeholder:" & vbTab & oShp.TextFrame.TextRange End Select Else Print #iFile, vbTab & oShp.TextFrame.TextRange End If ' msoPlaceholder End If ' Has text frame/Has text Next oShp Next oSld 'Close output file Close #iFile End Sub
And here we get a bit trickier and go after the text that's in groups. And in groups within groups.
Look at this too closely and your head may start to hurt.
Sub ExportText() Dim oPres As Presentation Dim oSlides As Slides Dim oSld As Slide 'Slide Object Dim oShp As Shape 'Shape Object Dim iFile As Integer 'File handle for output iFile = FreeFile 'Get a free file number Dim PathSep As String Dim FileNum As Integer Dim sTempString As String #If Mac Then PathSep = ":" #Else PathSep = "\" #End If Set oPres = ActivePresentation Set oSlides = oPres.Slides FileNum = FreeFile 'Open output file ' NOTE: errors here if file hasn't been saved Open oPres.Path & PathSep & "AllText.TXT" For Output As FileNum For Each oSld In oSlides 'Loop thru each slide ' Include the slide number (the number that will appear in slide's ' page number placeholder; you could also use SlideIndex ' for the ordinal number of the slide in the file Print #iFile, "Slide:" & vbTab & cstr(oSld.SlideNumber) For Each oShp In oSld.Shapes 'Loop thru each shape on slide 'Check to see if shape has a text frame and text If oShp.HasTextFrame And oShp.TextFrame.HasText Then If oShp.Type = msoPlaceholder Then Select Case oShp.PlaceholderFormat.Type Case Is = ppPlaceholderTitle, ppPlaceholderCenterTitle Print #iFile, "Title:" & vbTab & oShp.TextFrame.TextRange Case Is = ppPlaceholderBody Print #iFile, "Body:" & vbTab & oShp.TextFrame.TextRange Case Is = ppPlaceholderSubtitle Print #iFile, "SubTitle:" & vbTab & oShp.TextFrame.TextRange Case Else Print #iFile, "Other Placeholder:" & vbTab & oShp.TextFrame.TextRange End Select Else Print #iFile, vbTab & oShp.TextFrame.TextRange End If ' msoPlaceholder Else ' it doesn't have a textframe - it might be a group that contains text so: If oShp.Type = msoGroup Then sTempString = TextFromGroupShape(oShp) If Len(sTempString) > 0 Then Print #iFile, sTempString End If End If End If ' Has text frame/Has text Next oShp Next oSld 'Close output file Close #iFile End Sub Function TextFromGroupShape(oSh As Shape) As String ' Returns the text from the shapes in a group ' and recursively, text within shapes within groups within groups etc. Dim oGpSh As Shape Dim sTempText As String If oSh.Type = msoGroup Then For Each oGpSh In oSh.GroupItems With oGpSh If .Type = msoGroup Then sTempText = sTempText & TextFromGroupShape(oGpSh) Else If .HasTextFrame Then If .TextFrame.HasText Then sTempText = sTempText & "(Gp:) " & .TextFrame.TextRange.Text & vbCrLf End If End If End If End With Next End If TextFromGroupShape = sTempText NormalExit: Exit Function Errorhandler: Resume Next End Function
See How do I use VBA code in PowerPoint? to learn how to use this example code.