Извлечение определенных ячеек из папки, полной идентичных таблиц Word

Question

У меня есть папка с формами Word, из которой я хочу извлечь несколько ключевых элементов информации: имя, номер, дату и содержимое одной ячейки.Я видел решения для импорта целых таблиц Word, но мне не нужна большая часть информации о таблицах.

Все формы в слове одинаковы, за исключением данных в ячейках, так как людииспользовали шаблон, чтобы сделать эти формы.Все клетки помечены справа от клеток, которые я на самом деле хочу.У меня есть папка, заполненная этими формами документов Word.

Я пытался изменить этот скрипт ( Извлечение данных из документа Word в таблицу Excel ), но мои навыки VBA ужасны, и я могуполучить больше, чем строку данных, прежде чем он выйдет из строя.

Как извлечь конкретные ячейки, содержащие данные, которые я хочу, из этих текстовых документов?Я даже был бы рад получить всю строку, в которой находятся данные.

Answer 1

Попробуйте следующий макрос Excel , который извлекает данные Word из ячеек D3, B12 и D25 в первой таблице каждого документа Word в выбранной папке.Имя документа выводится в столбец A, а остальные данные выводятся в столбцы BD.Это только 3 элемента из каждого файла, но ваша ссылка на «Имя, число, дату и содержимое одной ячейки» подразумевает, что их 4.

Sub GetTableData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim strFolder As String, strFile As String, WkSht As Worksheet, r As Long
strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit
Set WkSht = ActiveSheet: r = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.doc", vbNormal)
With wdApp
  'Hide our Word session
  .Visible = False
  'Disable any auto macros in the documents being processed
  .WordBasic.DisableAutoMacros
  While strFile <> ""
    Set wdDoc = .Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    r = r + 1: WkSht.Range("A" & r) = Split(strFile, ".doc")(0)
    With wdDoc
      If .Tables.Count > 0 Then
        With .Tables(1)
          WkSht.Range("B" & r) = Split(.Cell(3, 4), vbCr)(0)
          WkSht.Range("C" & r) = Split(.Cell(12, 2), vbCr)(0)
          WkSht.Range("D" & r) = Split(.Cell(25, 4), vbCr)(0)
        End With
      End If
      .Close SaveChanges:=False
    End With
    strFile = Dir()
  Wend
  .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing    Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function