export all text on slide AND all notes to 1 txt file with a macro?

[Elke Thone]

I'm using a macro from PPTtools to export all text on my slide to a text
file in Microsoft PowerPoint 2000.
Now I would like to combine this marco with another one of PPTtools, namely
to export notes to this same text file.
The problem is that I don't know any VB, so I have no clue as to how to
combine the two.

Here's the macro that I'm using now:
Sub ExportText()

Dim oSld As Slide 'Slide Object
Dim oShp As Shape 'Shape Object
Dim iFile As Integer 'File handle for output
Dim sSlideOutputFolder As String
Dim sPreText As String
Dim s As Integer

'zet hier het pad en de tekst voor de nummering juist
sSlideOutputFolder = "L:\scrap\"
sPreText = "Fext"

iFile = FreeFile 'Get a free file number

For Each oSld In ActivePresentation.Slides 'Loop thru each slide
'Open output file
Open sSlideOutputFolder & sPreText & Format(oSld.SlideIndex, "00") & ".txt"
For Output As iFile

s = 1

'ungroup alle items op de slide
Do Until s = 4
For Each oShp In oSld.Shapes 'Loop thru each shape on Slide
If oShp.Type = msoGroup Or oShp.Type = msoEmbeddedOLEObject Or oShp.Type =
msoLinkedOLEObject Or oShp.Type = msoTable Then
oShp.Ungroup
End If
Next oShp
s = s + 1
Loop


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
Print #iFile, oShp.TextFrame.TextRange
End If

Next oShp
'Close output file
Close #iFile
Next oSld

End Sub

And here's the macro that I would like to incorporate in the one above:
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.SlideNumber) & 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

Thanks for any help,
Elke

 

[Steve Rindsberg]

I'm using a macro from PPTtools to export all text on my slide to a text
file in Microsoft PowerPoint 2000.

If you mean the macro code that comes from www.pptfaq.com, that's not the same
as PPTools. And this seems to have been changed a bit from what's up there.

Here's the macro that I'm using now:
Sub ExportText()

Dim oSld As Slide 'Slide Object
Dim oShp As Shape 'Shape Object
Dim iFile As Integer 'File handle for output
Dim sSlideOutputFolder As String
Dim sPreText As String
Dim s As Integer

'zet hier het pad en de tekst voor de nummering juist
sSlideOutputFolder = "L:\scrap\"
sPreText = "Fext"

iFile = FreeFile 'Get a free file number

For Each oSld In ActivePresentation.Slides 'Loop thru each slide
'Open output file
Open sSlideOutputFolder & sPreText & Format(oSld.SlideIndex, "00") & ".txt"
For Output As iFile

s = 1

'ungroup alle items op de slide

Why this?

Do Until s = 4

For Each oShp In oSld.Shapes 'Loop thru each shape on Slide
If oShp.Type = msoGroup Or oShp.Type = msoEmbeddedOLEObject Or oShp.Type =
msoLinkedOLEObject Or oShp.Type = msoTable Then
oShp.Ungroup
End If
Next oShp
s = s + 1
Loop

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
Print #iFile, oShp.TextFrame.TextRange
End If

Next oShp

' Try adding this here
For Each oShp In oSld.NotesPage.Shapes
If oShp.PlaceholderFormat.Type = ppPlaceholderBody Then
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
Print #iFile, oShp.TextFrame.TextRange
End If
End If
End If
Next oSh

 

[Elke Thone]

Thank you, it works fine now.
(some more feedback below for those interested)

If you mean the macro code that comes from www.pptfaq.com, that's not the
same
as PPTools. And this seems to have been changed a bit from what's up
there.

I did mean www.pptfaq.com, sorry for the mixup.

Why this?

The macro was adapted for me by someone that I lost contact with now, but I
believe he added this because I also wanted the text inside graphs to appear
in the txt files, and by ungrouping, the graph objects become groups and all
values and legends etc in the graph are added as text to the text files.
(Of course, I have to be careful not to save my PPTfile afterwards, because
then my graphs are all messed up).

' Try adding this here
For Each oShp In oSld.NotesPage.Shapes
If oShp.PlaceholderFormat.Type = ppPlaceholderBody Then
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
Print #iFile, oShp.TextFrame.TextRange
End If
End If
End If
Next oSh

I added this part where you suggested, but got an error: "PlaceholderFormat
(unknown member): Invalid request. Shape is not a placeholder."
However, I found the solution in one of your posts:
http://www.helpfeeds.com/archive/index.php/t-43905.html and I've added "If
oSh.Type = msoPlaceholder Then" ... "End If" (and I have no clue what it
does, but it solved the problem.)

Here's the complete macro I'm using now, it works great.

Sub ExportText()

Dim oSld As Slide 'Slide Object
Dim oShp As Shape 'Shape Object
Dim iFile As Integer 'File handle for output
Dim sSlideOutputFolder As String
Dim sPreText As String
Dim s As Integer

'path on local disk
sSlideOutputFolder = "L:\scrap\"
sPreText = "Fext"

iFile = FreeFile 'Get a free file number

For Each oSld In ActivePresentation.Slides 'Loop thru each slide
'Open output file
Open sSlideOutputFolder & sPreText & Format(oSld.SlideIndex, "00") &
".txt" For Output As iFile

s = 1

'ungroup alle items op de slide
Do Until s = 4
For Each oShp In oSld.Shapes 'Loop thru each shape on
Slide
If oShp.Type = msoGroup Or oShp.Type = msoEmbeddedOLEObject Or
oShp.Type = msoLinkedOLEObject Or oShp.Type = msoTable Then
oShp.Ungroup
End If
Next oShp
s = s + 1
Loop


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
Print #iFile, oShp.TextFrame.TextRange
End If

Next oShp
' Get notes
For Each oShp In oSld.NotesPage.Shapes
If oShp.Type = msoPlaceholder Then
If oShp.PlaceholderFormat.Type = ppPlaceholderBody Then
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
Print #iFile, oShp.TextFrame.TextRange
End If
End If
End If
End If
Next oShp

'Close output file
Close #iFile
Next oSld

End Sub

Thanks a lot for your help,
Elke

 

[Steve Rindsberg]

Thank you, it works fine now.
(some more feedback below for those interested)

Glad to hear it's working. Nice work on fixing up the other little problem
yourself.