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
This was first published in October 2004