Sub ПАРСИНГ_WORD()
 
Dim wrdDoc As Object, objFiles As Object, fso As Object, wordApp As Object
Dim sh1 As Worksheet
Dim x As Integer

Dim SourcePath As String
Dim DestinationPath As String
 
 
FolderName = "C:\Users\user\Рабочий стол\резюме"
'папка где лежат мои файлы doc

Set sh1 = ThisWorkbook.Sheets(1)
Set fso = CreateObject("Scripting.FileSystemObject")
Set wordApp = CreateObject("Word.application")
Set objFiles = fso.GetFolder(FolderName).Files
 
x = 2
For Each wd In objFiles
    If InStr(wd, ".doc") And InStr(wd, "~") = 0 Then
        Set wrdDoc = wordApp.Documents.Open(wd.Path, ReadOnly = True)
        
        FreeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
      'здесь нахожу следующию свободную строку для вывода


        sh1.Cells(FreeRow, 1) = wd.Name
      'вывожу имя файла в ячейку
        
        
        sh1.Cells(FreeRow, 2) = wrdDoc.Tables(1).Cell(Row:=1, Column:=1).Range

        
        
        x = x + 1
        wrdDoc.Close


SourcePath = "C:\Users\user\Рабочий стол\fw\" + wd.Name
DestinationPath = "C:\Users\user\Рабочий стол\резюме\обработанные\" + wd.Name

Name SourcePath As DestinationPath
'этой фунцией я перемещаю обработанный файл в папку обработанные
    
End If
 
Next wd
wordApp.Quit
End Sub