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.
