Загрузка данных


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