パワポのテキスト抽出VBA

パワーポイントファイルの中の、テキストを抽出するＶＢＡ。
フォントサイズが20以上のテキストを見つけたら、抽出。

Sub PPT_pdf()

   Dim ppt As New PowerPoint.Application
   Dim presen1 As PowerPoint.Presentation
   Dim save_path As String, file_name As String
   Dim Target As String
   
   'ターゲットファイルpptxを選択させて選択したファイルを開く
   Target = Application.GetOpenFilename("PowerPoint,*.pptx")
   If Target = "False" Then Exit Sub
   Set presen1 = ppt.Presentations.Open(Target, WithWindow:=MsoTriState.msoFalse)

   '結果出力用のテキストファイルを開く
   Dim fs As Object
   Dim stream As Object
   Set fs = CreateObject("Scripting.FileSystemObject")
   Set stream = fs.OpenTextFile("d:\extracted_text.txt", 2, True)
   
   '各スライドを探索し、フォントサイズが20以上のテキストがあれば
   '結果出力用のテキストに書出し
   For Each sl In presen1.Slides
     stream.Write "slide-" & sl.SlideNumber
     stream.WriteLine
     For Each shape1 In sl.Shapes
       If shape1.HasTextFrame Then
         If shape1.TextFrame.TextRange.Font.Size >= 20 Then
            Dim txt As String
            txt = shape1.TextFrame.TextRange.Text
            stream.Write txt
            stream.WriteLine
         End If
       End If
     Next
     stream.WriteLine
   Next
   stream.Close
   
End Sub