Extract text content from PPT and output file as a word doc

Question

Taken dis codes from random sites using for extract the text content in Slide and Notes section from PPT slides. But the output file given as a NOTEPAD. I want the o/p file as a word document. Can anyone to help on this? Thanks to you in advance

P.S. I express my gratitude those who created these codes and simplify my work.

Option Explicit

Sub ExportNotesText()
Dim oSlides As Slides
Dim oSl As Slide
Dim oSh As Shape
Dim strNotesText As String
Dim strFileName As String
Dim intFileNum As Integer
Dim lngReturn As Long

' Get a filename to store the collected text
strFileName = InputBox("Enter the full path and name of file to extract notes text to", "Output file?")
' did user cancel?
 If strFileName = "" Then
    Exit Sub
End If

' is the path valid?  crude but effective test:  try to create the file.
intFileNum = FreeFile()
On Error Resume Next
Open strFileName For Output As intFileNum
If Err.Number <> 0 Then     ' we have a problem
MsgBox "Couldn't create the file: " & strFileName & vbCrLf _ & "Please try again."
Exit Sub
End If
Close #intFileNum  ' temporarily
' Get the notes text  

Set oSlides = ActivePresentation.Slides

For Each oSl In oSlides
    strNotesText = strNotesText & "======================================" & vbCrLf
    strNotesText = strNotesText & "Slide" & oSl.SlideIndex & vbCrLf
    strNotesText = strNotesText & SlideText(oSl) & vbCrLf
    strNotesText = strNotesText & NotesText(oSl) & vbCrLf
   Next oSl
     
' now write the text to file
Open strFileName For Output As intFileNum
Print #intFileNum, strNotesText
Close #intFileNum

' show what we've done
lngReturn = Shell("NOTEPAD.EXE " & strFileName, vbNormalFocus)

End Sub
Function SlideText(oSl As Slide) As String
Dim oSh As Shape
Dim osld As Slide
Dim strNotesText As String
For Each oSh In oSl.Shapes
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
SlideText = SlideText & oSh.Name & ":" & " " & oSh.TextFrame.TextRange & vbCrLf
End If
End If
Next oSh
End Function

Function NotesText(oSl As Slide) As String
Dim oSh As Shape
For Each oSh In oSl.NotesPage.Shapes
    If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then
        If oSh.HasTextFrame Then
            If oSh.TextFrame.HasText Then
                NotesText = oSh.TextFrame.TextRange.Text
            End If
        End If
    End If
Next oSh

End Function

Answer 1

For Example:

Sub Demo()
'Note: A VBA Reference to Word is required.
'See under Tools|References
Dim WdApp As New Word.Application, wdDoc As Word.Document
Dim Sld As Slide, Shp As Shape
Set wdDoc = WdApp.Documents.Add
For Each Sld In ActivePresentation.Slides
  With Sld
    For Each Shp In .NotesPage.Shapes
      With Shp
        If .PlaceholderFormat.Type = ppPlaceholderBody Then
          If .HasTextFrame Then
            If .TextFrame.HasText Then
              wdDoc.Range.InsertAfter vbCr & Sld.SlideIndex & ": " & .TextFrame.TextRange.Text
            End If
          End If
        End If
      End With
    Next
    For Each Shp In .Shapes
      With Shp
        If .HasTextFrame Then
          If .TextFrame.HasText Then
            wdDoc.Range.InsertAfter vbCr & .Name & ": " & .TextFrame.TextRange.Text
          End If
        End If
      End With
    Next
  End With
Next
WdApp.Visible = True: wdDoc.Activate
Set wdDoc = Nothing: Set WdApp = Nothing
End Sub