DragText from PowerPoint

Sub TextDerg()
Dim slide As PowerPoint.slide
Dim shape As PowerPoint.shape
Dim expString As String

  Set slide = ActivePresentation.Slides(1)

  For Each slide In ActivePresentation.Slides

    expString = expString & vbCrLf & "=================== " & slide.Name & "====================== "
    For Each shape In slide.Shapes
      If shape.HasTextFrame Then
        expString = expString & vbCrLf & shape.TextFrame.TextRange.Text
      End If
    Next

  Next

  Open "E:\Temp\2Delete\PPT\try.txt" For Output As #1
  Debug.Print Len(expString)
  Write #1, expString
  Close #1

  Set slide = Nothing

End Sub