httpReq.setRequestHeader "method", "base64"
httpReq.send "body=" & изображение

Sub ParsingDoc()

Dim wrdDoc As Object, objFiles As Object, fso As Object, wordApp As Object
Dim sh1 As Worksheet
Dim x As Integer

FolderName = "D:\Pars" ' Директория с файлами

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, ".docx") And InStr(wd, "~") = 0 Then
        Set wrdDoc = wordApp.Documents.Open(wd.Path, ReadOnly = True)
' 1. Выведение наименования файла в столбец A
sh1.Cells(x, 1) = wd.Name
        
' 2. Поиск даты Сведений в таблице № 1. Переменная dateA, da
Dim dateA As String, da As Long
dateA = wrdDoc.Tables(1).Cell(1, 1).Range
da = InStr(1, dateA, "", 1)
If da > 0 Then
dateA = Mid(dateA, da + 0, Len(dateA) - da - 3)
da = InStr(1, dateA, " г.", 1)
If da > 0 Then
dateA = Mid(dateA, 1, da - 1)
End If
End If
sh1.Cells(x, 2) = dateA

' 3. Поиск ФИО в таблице № 2. Переменная fio, fa
Dim fio As String, fa As Long
fio = wrdDoc.Tables(2).Cell(5, 2).Range
fa = InStr(1, fio, "", 1)
If fa > 0 Then
fio = Mid(fio, fa + 0, Len(fio) - fa - 5)
fa = InStr(1, fio, " род.", 1)
If fa > 0 Then
fio = Mid(fio, 1, fa - 1)
End If
End If
sh1.Cells(x, 3) = fio

' 4. Поиск Даты Договора оказания услуг в таблице № 2

x = x + 1
wrdDoc.Close
End If

Next wd
wordApp.Quit
End Sub

Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Постановление"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
sh1.Cells(x, 7) = ???

Sub wordScrape()()

Dim wrdDoc As Object, objFiles As Object, fso As Object, wordApp As Object
Dim sh1 As Worksheet
Dim x As Integer

FolderName = "H:\" ' Директория с файлами

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, ".docx") And InStr(wd, "~") = 0 Then
        Set wrdDoc = wordApp.Documents.Open(wd.Path, ReadOnly = True)
        sh1.Cells(x, 1) = wd.Name
        sh1.Cells(x, 2) = wrdDoc.Tables(1).Cell(Row:=1, Column:=1).Range
        'sh1.Cells(x, 3) = для других аргументов, где x=строка, число=столбец
        x = x + 1
    wrdDoc.Close
    End If

Next wd
wordApp.Quit
End Sub