---

Sub ParseByEmptyLines()
    Dim wd As Object, doc As Object
    Dim sh As Worksheet
    Dim path As String, f As String
    Dim r As Long, i As Long
    Dim blocks() As String
    
    path = "C:\Docs\"  ' CHANGE THIS
    
    Set sh = ThisWorkbook.Sheets(1)
    sh.Cells.Clear
    r = 2
    
    Set wd = CreateObject("Word.Application")
    wd.Visible = False
    
    f = Dir(path & "*.doc*")
    
    Do While f <> ""
        Set doc = wd.Documents.Open(path & f)
        blocks = Split(doc.Range.Text, vbNewLine & vbNewLine)
        doc.Close False
        
        sh.Cells(r, 1) = f
        For i = 0 To UBound(blocks)
            sh.Cells(r, i + 2) = Trim(blocks(i))
        Next i
        
        r = r + 1
        f = Dir()
    Loop
    
    wd.Quit False
    MsgBox "Done! Processed " & r - 2 & " files"
End Sub