unable to extract text from ppt in backgrounf

[Co]

Hi All,

I want to open a ppt and extract the text but without ppt actualy
being shown.
I get an error saying there is no presentation open.
What do I do wrong?

Public Function Iterate_Through_All_Shapes(FName As String)

Dim ppApp As Object
Dim iShape As Integer
Dim iNotesShape As Integer
Dim iSlide As Integer
Dim NotesText As String
Dim FileNum As Integer

Set ppApp = CreateObject("powerpoint.application")

With ppApp
.Activate
.Presentations.Open FileName:=FName, ReadOnly:=False
.Visible = True
.WindowState = ppWindowMinimized
End With

For iSlide = 1 To ppApp.ActivePresentation.Slides.Count
With ppApp.ActivePresentation.Slides(iSlide)
'tekst uit de slide halen
For iShape = 1 To .Shapes.Count
With .Shapes(iShape)
If .HasTextFrame And .TextFrame.HasText Then
NotesText = NotesText
& .TextFrame.TextRange.Text & vbCrLf & vbCrLf
End If
End With
Next iShape
'eventueel tekst uit de notespage halen
For iNotesShape = 1 To .NotesPage.Shapes.Count
With .NotesPage.Shapes(iNotesShape)
If .HasTextFrame And .TextFrame.HasText Then
NotesText = NotesText
& .TextFrame.TextRange.Text & vbCrLf & vbCrLf
End If
End With
Next iNotesShape
End With
Next iSlide

FileNum = FreeFile
Open ppApp.ActivePresentation.Path & "\" &
Left(ppApp.ActivePresentation.Name, _
Len(ppApp.ActivePresentation.Name) - 4) & ".txt" For Output
As FileNum
Print #FileNum, NotesText
Close FileNum

ppApp.Quit
Set ppApp = Nothing


End Function


Marco

 

[Co]

Thanks for posting the code; but on what line does the error occur?
Are you certain that FName contains a full and valid path to a PPT/PPS file?












-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================

The error occures here:
For iSlide = 1 To ppApp.ActivePresentation.Slides.Count

It says there is no activepresentation.

Marco

 

[Co]

I'll ask again:

Are you certain that FName contains a full and valid path to a PPT/PPS file?

I tried the code here, running it from within Word 2003 and calling it with:

Sub TestMe()
Call Iterate_Through_All_Shapes("some file name.ppt")
End Sub

Other than one minor problem it works:

ppWindowMinimized is a PPT constant, not a VBA one.
If you're using this code outside PPT, you'll want to either define it:

Const ppWindowMinimized as Long = 2

or just use the value 2 instead.

-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================

I had send you my initial code which did work.
However I want the ppt to be extracted without being shown, like Word
does.

Marco

 

[Co]

Start over then:

Post the code that DOESN'T work, not code that does.

Say what line it errors on.

Say what the precise error message is.

Say whether you have, in fact, made sure you're passing a valid path/file to the
function. This is the third time I've asked. Humor me. Thanks.

Mention what program you're running this code in (I'm assuming it's not
PowerPoint, but if it is, say so)

I will try to answer all the Qs.

The code that doesn't work:

Public Function Iterate_Through_All_Shapes(FName As String)

Dim ppApp As Object
Dim iShape As Integer
Dim iNotesShape As Integer
Dim iSlide As Integer
Dim NotesText As String
Dim FileNum As Integer

Set ppApp = CreateObject("powerpoint.application")

With ppApp
.Presentations.Open FileName:=FName, ReadOnly:=False,
WindowStatus:=False
End With

For iSlide = 1 To ppApp.ActivePresentation.Slides.Count
With ppApp.ActivePresentation.Slides(iSlide)
'tekst uit de slide halen
For iShape = 1 To .Shapes.Count
With .Shapes(iShape)
If .HasTextFrame And .TextFrame.HasText Then
NotesText = NotesText
& .TextFrame.TextRange.Text & vbCrLf & vbCrLf
End If
End With
Next iShape
'eventueel tekst uit de notespage halen
For iNotesShape = 1 To .NotesPage.Shapes.Count
With .NotesPage.Shapes(iNotesShape)
If .HasTextFrame And .TextFrame.HasText Then
NotesText = NotesText
& .TextFrame.TextRange.Text & vbCrLf & vbCrLf
End If
End With
Next iNotesShape
End With
Next iSlide


FileNum = FreeFile
Open ppApp.ActivePresentation.Path & "\" &
Left(ppApp.ActivePresentation.Name, _
Len(ppApp.ActivePresentation.Name) - 4) & ".txt" For Output
As FileNum
Print #FileNum, NotesText
Close FileNum

ppApp.Quit
Set ppApp = Nothing

End Function

The erro occures at line:
For iSlide = 1 To ppApp.ActivePresentation.Slides.Count

It says there is no Active Presentation.

Probably because when you don't open ppt visually there is no
presentation.
I asume you can't open ppt like word with the window at the
background!!!!

I'm using this code in VB6.
The path to the file is correct, however it doesn't come to that cause
it crashes before
even reading the filename.

Hope that's something to go on.

Marco

 

[Co]

Great ... thanks. Now we're moving along.

Instead of referencing ActivePresentation, you can get a reference to the
presentation when you open it, then use the reference through out the code.

Also, you want to use WithWindow rather than WindowStatus

I've made the changes in the version below:

Public Function Iterate_Through_All_Shapes(FName As String)

Dim ppApp As Object
Dim ppPres As Object
Dim iShape As Integer
Dim iNotesShape As Integer
Dim iSlide As Integer
Dim NotesText As String
Dim FileNum As Integer

Set ppApp = CreateObject("powerpoint.application")

With ppApp
' WithWindow, not WindowStatus
Set ppPres = .Presentations.Open(FileName:=FName, ReadOnly:=False,
WithWindow:=False)
End With

For iSlide = 1 To ppPres.Slides.Count
With ppPres.Slides(iSlide)
'tekst uit de slide halen
For iShape = 1 To .Shapes.Count
With .Shapes(iShape)
If .HasTextFrame And .TextFrame.HasText Then
NotesText = NotesText & .TextFrame.TextRange.Text & vbCrLf &
vbCrLf
End If
End With
Next iShape
'eventueel tekst uit de notespage halen
For iNotesShape = 1 To .NotesPage.Shapes.Count
With .NotesPage.Shapes(iNotesShape)
If .HasTextFrame And .TextFrame.HasText Then
NotesText = NotesText & .TextFrame.TextRange.Text & vbCrLf &
vbCrLf
End If
End With
Next iNotesShape
End With
Next iSlide

FileNum = FreeFile

Open ppPres.Path & "\" & Left(ppPres.Name, _
Len(ppPres.Name) - 4) & ".txt" For Output As FileNum
Print #FileNum, NotesText
Close FileNum

ppApp.Quit
Set ppApp = Nothing
Set ppPres = Nothing

End Function





















-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================

Steve,

Thanks for that. It works fine.

MArco