Получить значения из документа word по маске макросом в excel - VBA

Формулировка задачи:

Здравствуйте! Подскажите, пожалуйста, можно ли макросом произвести поиск по маске в документах Word и вывести все значения в таблицу Excel? И как это сделать? Ситуация: есть около 300 документов word нужно достать значения, находящиеся в фигурных скобках Пример {Part1.1.8 REQ 2.8.1.f1.3.2-000-X, 2.8.1.1.2.7-000-Z} Т.е. маска поиска в word подстановочными знаками [{]?*[}] В экселе нужно получить: имя файла | Part1.1.8 REQ 2.8.1.f1.3.2-000-X, 2.8.1.1.2.7-000-Z (все значения в скобках по документу через запятую и пробел) Уважаемый

toiai

в теме Получить определенные значения из документа word макросом помогал участнику форума с аналогичной задачей, однако, у меня не получается адаптировать этот макрос под мою задачу.

Решение задачи: «Получить значения из документа word по маске макросом в excel»

textual
                            Листинг программы 
                        

                            Sub InfaScobok()
    Dim b(), i&, j&, txt$, n&, k&, rw&, NameFile$, col&
    Workbooks.Add
    Set ShExcel = ActiveSheet
    Cells(1, 1) = "Имя файла"
    FileDocs = Application.GetOpenFilename(filefilter:="Documents(*.doc;*.docx),*.doc;*.docx", _
                Title:="Выберите файлы с данными", MultiSelect:=True)
    If Not IsArray(FileDocs) Then Exit Sub
    Application.ScreenUpdating = False
    Set objWord = CreateObject("Word.Application")
    'objWord.Visible = True
    For k = 1 To UBound(FileDocs)
        With objWord.Documents.Open(FileDocs(k))
            txt = .Range.Text
            s = Split(txt, "{")
            NameFile = .Name
            .Close
            If UBound(s) = 0 Then GoTo Sled
            ReDim b(1 To UBound(s), 1 To 1)
        End With
        For n = 1 To UBound(s)
            txt = Split(s(n), "}")(0)
            col = Len(txt) \ 256 + 1
            If col > UBound(b, 2) Then ReDim Preserve b(1 To UBound(b, 1), 1 To col)
            For i = 1 To col
                b(n, i) = Mid(txt, (i - 1) * 256 + 1, 256)
            Next
        Next
        With ShExcel
            rw = .UsedRange.Rows.Count + 1
            .Cells(rw, 1).Resize(UBound(b), 1) = NameFile
            .Cells(rw, 2).Resize(UBound(b), UBound(b, 2)) = b
        End With
Sled:
    Next
    Application.ScreenUpdating = True
    objWord.Quit
End Sub
                        