Sub SimpleParse()
Dim wd As Object, doc As Object
Dim sh As Worksheet
Dim path As String, f As String
Dim r As Long
' ===== УКАЖИТЕ ВАШ ПУТЬ =====
path = "C:\МоиДокументы\" ' ИЗМЕНИТЕ НА ВАШ ПУТЬ
Set sh = ThisWorkbook.Sheets(1)
sh.Cells.Clear
r = 2
Set wd = CreateObject("Word.Application")
wd.Visible = False
f = Dir(path & "*.doc*") ' Ищем все Word файлы
Do While f <> "" And r <= 51
Set doc = wd.Documents.Open(path & f)
' ЗАПИСЫВАЕМ ДАННЫЕ
sh.Cells(r, 1) = f ' Имя файла
sh.Cells(r, 2) = Left(doc.Range.Text, 500) ' Текст (первые 500 символов)
sh.Cells(r, 3) = doc.Tables.Count ' Количество таблиц
doc.Close False
r = r + 1
f = Dir()
Loop
wd.Quit False
MsgBox "Готово! Обработано " & r - 2 & " файлов"
End Sub