Public Sub ReadText()
Dim lngJunk As Long
Dim oShp As Shape
Dim rngStory As Word.Range
Dim opar As Paragraph
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
  'Iterate through all linked stories
  Do
    For Each opar In rngStory.Paragraphs
      Debug.Print opar.Range.Text
    Next opar
    On Error Resume Next
    Select Case rngStory.StoryType
      Case 6, 7, 8, 9, 10, 11
        If rngStory.ShapeRange.Count > 0 Then
          For Each oShp In rngStory.ShapeRange
            If oShp.TextFrame.HasText Then
              For Each opar In rngStory.Paragraphs
                 Debug.Print opar.Range.Text
              Next opar
            End If
          Next
        End If
      Case Else
        'Do Nothing
    End Select
    On Error GoTo 0
    'Get next linked story (if any)
    Set rngStory = rngStory.NextStoryRange
  Loop Until rngStory Is Nothing
Next
End Sub