Class not registered bug in code (PPT)

[ThrottleWorks]

Hi,

I am trying to use code from below URL.
Extracting all text from a powerpoint file in VBA - Stack Overflow

When trying to run this code, am getting bug as 'Class not registered' at Set p = ActivePresentation this line.
Can anyone please help me in this.

Sub GetAllText()
    Dim s As Slide
    Dim sh As Shape
    Dim p As Presentation
    
    Set PPT = CreateObject("PowerPoint.Application")
    If PPT Is Nothing Then Set PPT = CreateObject(class:="PowerPoint.Application")
    Set p = ActivePresentation
    
    For Each s In p.Slides
        For Each sh In s.Shapes
            If sh.HasTextFrame Then
                If sh.TextFrame.HasText Then
                    Debug.Print sh.TextFrame.TextRange.Text
                End If
            End If
        Next
    Next
End Sub

 

[Debaser]

If this is in Excel, it won't work.

 

[ThrottleWorks]

Hi @Debaser sir, thanks a lot for the help. You are correct. I am trying this in Excel only.
Could you please help me in this if you get time.
Have a nice day ahead.

 

[Debaser]

It doesn't make a lot of sense. You just started a new PP instance, so there is no presentation open.

 

[ThrottleWorks]

Hi @Debaser sir, thanks a lot for the help, am going through the code once again.

 

[p45cal]

Set p = ActivePresentation
I suspect should be
Set p = PPT.ActivePresentation
but since you've only started the PowerPoint App there won't be any presentation.

I suspect the code was originally written to fetch an existing instance of PowerPoint and if that wasn't present to open the PowerPoint app, say like:

Set PPT = GetObject(, "PowerPoint.Application")
If PPT Is Nothing Then Set PPT = CreateObject(class:="PowerPoint.Application")

You've used late-binding in the above lines yet in the declarations at the top you have:

Dim s As Slide
Dim sh As Shape
Dim p As Presentation

which presupposes early binding for which you must have a reference to the PowerPoint Object Library in Tools|Refences of the VBE.

So if you have a presentation already open the code should work fine in two cases:
1. No reference to the PowerPoint Object Library and amend the code to:

Sub GetAllText()
Dim s
Dim sh
Dim p
   
Set PPT = GetObject(, "PowerPoint.Application")
If PPT Is Nothing Then Set PPT = CreateObject(class:="PowerPoint.Application")
Set p = PPT.ActivePresentation
   
For Each s In p.Slides
  For Each sh In s.Shapes
    If sh.HasTextFrame Then
      If sh.TextFrame.HasText Then
        Debug.Print sh.TextFrame.TextRange.Text
      End If
    End If
  Next
Next
End Sub

2. A reference to the PowerPoint Object Library set and:

Sub GetAllText()
Dim s As slide
Dim sh As PowerPoint.Shape
Dim p As Presentation
   
Set PPT = GetObject(, "PowerPoint.Application")
If PPT Is Nothing Then Set PPT = CreateObject(class:="PowerPoint.Application")
Set p = PPT.ActivePresentation
   
For Each s In p.Slides
  For Each sh In s.Shapes
    If sh.HasTextFrame Then
      If sh.TextFrame.HasText Then
        Debug.Print sh.TextFrame.TextRange.Text
      End If
    End If
  Next
Next
End Sub

Note the Dim sh As PowerPoint.Shape otherwise it'll be an Excel shape which won't do at all.

If there's no PowerPoint application and presentation already open then you'll have to go about loading/opening a PowerPoint presentation too.

 

[ThrottleWorks]

Hi @p45cal sir, thanks for the help. Am going through your code and will revert if I need more help.
Have a nice day ahead.

 

[ThrottleWorks]

Hi @p45cal sir, I tried editing second code of yours, it is working great, thanks a lot.
Have a nice day ahead.