How do I export powerpoint slide notes to individual text files? - vba

Question

Through some research, I came across this VBA code on the following site:
http://www.pptfaq.com/FAQ00481_Export_the_notes_text_of_a_presentation.htm
Sub ExportNotesText()
Dim oSlides As Slides
Dim oSl As Slide
Dim oSh As Shape
Dim strNotesText As String
Dim strFileName As String
Dim intFileNum As Integer
Dim lngReturn As Long
' Get a filename to store the collected text
strFileName = InputBox("Enter the full path and name of file to extract notes text to", "Output file?")
' did user cancel?
If strFileName = "" Then
Exit Sub
End If
' is the path valid? crude but effective test: try to create the file.
intFileNum = FreeFile()
On Error Resume Next
Open strFileName For Output As intFileNum
If Err.Number <> 0 Then ' we have a problem
MsgBox "Couldn't create the file: " & strFileName & vbCrLf _
& "Please try again."
Exit Sub
End If
Close #intFileNum ' temporarily
' Get the notes text
Set oSlides = ActivePresentation.Slides
For Each oSl In oSlides
For Each oSh In oSl.NotesPage.Shapes
If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
strNotesText = strNotesText & "Slide: " & CStr(oSl.SlideIndex) & vbCrLf _
& oSh.TextFrame.TextRange.Text & vbCrLf & vbCrLf
End If
End If
End If
Next oSh
Next oSl
' now write the text to file
Open strFileName For Output As intFileNum
Print #intFileNum, strNotesText
Close #intFileNum
' show what we've done
lngReturn = Shell("NOTEPAD.EXE " & strFileName, vbNormalFocus)
End Sub
It essentially exports ALL the slide notes from a Powerpoint file into ONE text file in chronological order of slides.
Is there anyway to alter the code to output the slide notes into multiple text files? What I mean is, if there are 4 slides in the powerpoint document, we would get an export of each slide's notes as follows:
slide1notes.txt
slide2notes.txt
slide3notes.txt
slide4notes.txt
Many thanks.

Answer 1

I didn't have a great deal of time to do more than aircode this, but:
Sub TryThis()
' Write each slide's notes to a text file
' in same directory as presentation itself
' Each file is named NNNN_Notes_Slide_xxx
' where NNNN is the name of the presentation
' xxx is the slide number
Dim oSl As Slide
Dim oSh As Shape
Dim strFileName As String
Dim strNotesText As String
Dim intFileNum As Integer
' Get the notes text
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.NotesPage.Shapes
If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
' now write the text to file
strFileName = ActivePresentation.Path _
& "\" & ActivePresentation.Name & "_Notes_" _
& "Slide_" & CStr(oSl.SlideIndex) _
& ".TXT"
intFileNum = FreeFile()
Open strFileName For Output As intFileNum
Print #intFileNum, oSh.TextFrame.TextRange.Text
Close #intFileNum
End If
End If
End If
Next oSh
Next oSl
End Sub

Answer 2

And since Mac PPT/VBA is bug-infested, here's a new version for Mac. Since I'm doing this on a PC and can't copy/paste to/from the Mac, I haven't run the code on Mac, but it should be ok:
Sub TryThis()
' Write each slide's notes to a text file
' in same directory as presentation itself
' Each file is named NNNN_Notes_Slide_xxx
' where NNNN is the name of the presentation
' xxx is the slide number
Dim oSl As Slide
Dim oSh As Shape
Dim strFileName As String
Dim strNotesText As String
Dim intFileNum As Integer
' Since Mac PPT will toss non-fatal errors, just keep moving along:
On Error Resume Next
' Get the notes text
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.NotesPage.Shapes
' Here's where the error will occur, if any:
If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then
' so deal with it if so:
If Err.Number = 0 Then
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
' now write the text to file
strFileName = ActivePresentation.Path _
& "\" & ActivePresentation.Name & "_Notes_" _
& "Slide_" & CStr(oSl.SlideIndex) _
& ".TXT"
intFileNum = FreeFile()
Open strFileName For Output As intFileNum
Print #intFileNum, oSh.TextFrame.TextRange.Text
Close #intFileNum
End If ' HasText
End If ' HasTextFrame
End If ' Err.Number = 0
End If ' PlaceholderType test
Next oSh
Next oSl
End Sub

Answer 3

If anyone needs the output in one txt-file:
Sub TryThis()
' Write each slide's notes to a text file
' in same directory as presentation itself
' Each file is named NNNN_Notes_Slide_xxx
' where NNNN is the name of the presentation
' xxx is the slide number
Dim oSl As Slide
Dim oSh As Shape
Dim strFileName As String
Dim strNotesText As String
Dim intFileNum As Integer
Dim strLine As String
Dim strData As String
' Since Mac PPT will toss non-fatal errors, just keep moving along:
On Error Resume Next
' Get the notes text
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.NotesPage.Shapes
' Here's where the error will occur, if any:
If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then
' so deal with it if so:
If Err.Number = 0 Then
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
strData = strData + "Folie " & oSl.SlideIndex & vbCrLf & oSh.TextFrame.TextRange.Text & vbCrLf & vbCrLf
Close #intFileNum
End If ' HasText
End If ' HasTextFrame
End If ' Err.Number = 0
End If ' PlaceholderType test
Next oSh
Next oSl
' now write the text to file
strFileName = ActivePresentation.Path _
& "\" & ActivePresentation.Name & "_Notes" _
& ".txt"
intFileNum = FreeFile()
Open strFileName For Output As intFileNum
Print #intFileNum, strData
Close #intFileNum
End Sub