Reading a PowerPoint file

I was given collection of PowerPoint files that had the main text 'all over the place' in title boxes, multiple text boxes, etc. Basically, it was a real mess and almost impossible to search.

I wanted to extract all of the text from the files, dump it into a Notes database and then sort out the mess so we could put it back into a standard template.

There are plenty of COM examples for interacting with Word and Excel, but almost nothing for PowerPoint. The following example is part of my overall solution. This gets a hold of the text on slides. Once you have all of the text then you can do what you like with it -- in this case it pastes into the current document's body field.

  
 Sub Click(Source As Button)
 
'This routine will prompt for a PPT file 
and cycle through all slides and
shapes within each slide. 
'It will then extract the text from each 
shape and enter it into the body
field of the current document. A blank 
line is put between each shape/slide.

Dim workspace As New NotesUIWorkspace
Dim uiDoc As NotesUIDocument
Dim doc As NotesDocument
Dim body As Variant
 
Dim pptFilename As String
Dim choice as Variant
 
Dim PowerPoint As Variant
Dim pptVer As String
Dim pptCOM As String
 
Dim pptPres As Variant
Dim pptSlides As Variant
Dim pptShapes As Variant
Dim pptText As Variant
Dim pptShapeText As String
 
Dim fullText As String
Dim nl As String

'Get the file to import
choice = workspace.OpenFileDialog
(False,"Please Select a powerpoint (.PPT)
File to Import","Powerpoint|*.ppt")

 
pptFileName = choice(0)

nl = Chr$(13) + Chr$(10)
fullText = ""
 
Print "Connecting to Powerpoint...."
'7.0 = 95, 8.0 = 97, 9.0 = 2000, 
10.0 = XP, 11.0 = 2003 'If you wanted,
 you
could look up the registry to return 
the installed version number.

pptVer = "10.0    
pptCOM = "PowerPoint.Application." & pptVer
  
Set PowerPoint = CreateObject( pptCOM ) 
 
PowerPoint.Visible = True
Set pptPres = PowerPoint.Presentations.
Open(pptFileName)
 
Set pptSlides = pptPres.Slides
Print "Number of Slide in Presentation = 
" & Cstr(pptSlides.Count)
 
Dim textOrig As Variant
Dim textFind As Variant
Dim textRepl As Variant
Dim textEnd As String

'cycle through the slides
For slide% = 1 To pptSlides.Count
Set pptShapes = pptSlides(slide%).
shapes Print "Slide # " & Cstr(slide%) & "
has " Cstr(pptShapes.Count) & " shapes"

'cycle through the shapes
For shape% = 1 To pptShapes.Count
If pptShapes(shape%).HasTextFrame 
Then 'we only want to work on text boxes

'get all text
Set pptText = pptShapes(shape%).
TextFrame.TextRange
pptShapeText = pptText.Text

If pptShapeText = "" Then
'We're going to ignore blank text boxes.
Print "Slide # " & Cstr(slide%) & ",  
Shape # " & Cstr(shape%) & "= Blank 
Shape - Skipping"

Else
'Tidy up funny characters
'replace char$(11)

textOrig = pptShapeText
textFind = Chr$(11)
textRepl = Chr$(32)
pptShapeText = Replace
(textOrig, textFind,textRepl)
     
'add the slide text to the fulltext with a 
black line at the end.
fullText = fullText + pptShapeText + nl + nl
     
End If
End If 
Next shape%
Next slide%
 
'apply to body field
Set uiDoc = workspace.CurrentDocument
Call uiDoc.FieldSetText("body",fullText)
 
Print "Cleaning up...."
Print "Disconnecting from Powerpoint..."
pptPres.Close  'Close the file
PowerPoint.Quit 'Close Powerpoint
Set PowerPoint = Nothing ' Free the
 memory that we'd used
Print " " ' Clear the status line 

End Sub

Do you have comments on this tip? Let us know.

This tip was submitted to the SearchDomino.com tip exchange by member John Humphreys. Please let others know how useful it is via the rating scale below. Do you have a useful Notes/Domino tip or code to share? Submit it to our monthly tip contest and you could win a prize and a spot in our Hall of Fame.

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.