Delete Powerpoint Slides containing keywords using VBA - vba

Question

I have a folder with 10 PowerPoint presentations. Each presentation has 20-25 slides.
Suppose I have a keyword "CX404","AR50". The macro should delete all slides having that keyword in the 10 presentations.
Public Sub DoFiles()
Dim strFileName As String
Dim strFolderName As String
Dim PP As Presentation
'set default directory here if needed
strFolderName = "D:\Users\Desktop\Shaon\pptss"
strFileName = Dir(strFolderName & "\*.pptx*")
Do While Len(strFileName) > 0
Set PP = Presentations.Open(strFolderName & "\" & strFileName)
'your code
Dim oSld As Slide
Dim oShp As Shape
Dim L As Long
For L = ActivePresentation.Slides.Count To 1 Step -1
Set oSld = ActivePresentation.Slides(L)
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
Select Case UCase(oShp.TextFrame.TextRange)
Case Is = "CX400", "AR50"
oSld.Delete
Case Else
'not found
End Select
End If
Next oShp
Next L
PP.Close
strFileName = Dir
Loop
End Sub
I can open all ppts in the folder. I am not be able to delete slides using my specific keywords.

Answer 1

I have slightly modified your listing and it works for me:
Option Explicit
Public Sub DoFiles()
Dim strFileName As String
Dim strFolderName As String
Dim PP As Presentation
Dim sText As String
strFolderName = "D:\111\"
strFileName = Dir(strFolderName & "\*.pptx*")
sText = "TEST"
Do While Len(strFileName) > 0
Set PP = Presentations.Open(strFolderName & "\" & strFileName)
Dim oSld As Slide
Dim oShp As Shape
Dim L As Long
For L = ActivePresentation.Slides.Count To 1 Step -1
Set oSld = ActivePresentation.Slides(L)
For Each oShp In oSld.Shapes
On Error Resume Next
If oShp.HasTextFrame Then
If UBound(Split(oShp.TextFrame.TextRange, sText)) > 0 Then
PP.Slides(L).Delete
End If
End If
Next oShp
Next L
PP.Save
PP.Close
strFileName = Dir
Loop
End Sub