Получить значения из документа 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