Копировать данные из нескольких файлов MS Word в Excel, используя VBA

Question

Я знаю, что этот вопрос уже задавался (копирование данных из нескольких слов документов в один лист Excel), но я не могу использовать ответ.

Я новичок в VBA, но я думал, что справлюсь. Я был неправ. Я пытался использовать код, предоставленный в упомянутой теме, для разбора некоторых документов Word, сначала с некоторыми изменениями, а затем просто используя оригинальный код. К сожалению, я получаю ошибку "Требуется объект" во время выполнения.

Код приведен ниже. Документы, из которых я пытаюсь получить данные, - это файлы Word 2003 (сначала я попытался изменить "docx" на "doc", затем сохранить документы в docx и использовать оригинальный скрипт, но это не помогло). Во-первых, они на самом деле сканируют и сканируют бумажные документы, так что ...
а) большинство таблиц внутри хранятся в фреймах (не знаю, если это что-то меняет, предположительно нет, учитывая их структуру XML)
б) когда я пытаюсь сохранить их как docx, приложение сначала предлагает сохранить их как rtfs. Так что, может быть, они на самом деле RTF-файлы, а не. DOC?

Sub macro1()
  Dim xl As Object
 Set xl = CreateObject("excel.application")

 xl.Workbooks.Add
 xl.Visible = True

 'Here put your path where you have your documents to read:
 myPath = "C:\some\path\"  'End with '\'
 myFile = Dir(myPath & "*.docx")

 xlRow = 1
 Do While myFile <> ""
  Documents.Open Filename:=myPath & myFile, ConfirmConversions:=False, _
     ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
     PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
     WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""

  xlCol = 0
  For Each t In ActiveDocument.Tables
     For Each r In t.Rows
        For Each c In r.Range.Cells
           myText = c
           myText = Replace(myText, Chr(13), "")
           myText = Replace(myText, Chr(7), "")
           xlCol = xlCol + 1
           xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol) = myText

        Next c
        xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol + 1) = myFile
        xlRow = xlRow + 1
        xlCol = 0
     Next r
  Next t
  ActiveWindow.Close False

  myFile = Dir
  Loop

 xl.Visible = True
 End Sub

Answer 1

Я проверил это. Это на самом деле работает, работает хорошо. Несколько моментов, которые следует иметь в виду перед использованием текущей версии кода:

1. Он должен быть добавлен в Word VBA, а не в Excel или другой (это может быть причиной того, почему вы получили ошибку "Требуется объект").
2. Обрабатывает просто .docx
3. Он обрабатывает все реальные таблицы MS Word, а не изображения, которые могут выглядеть как таблицы.

Я немного изменил код, чтобы сделать его немного более читабельным, по крайней мере для меня, из мира Excel VBA. Вы всегда должны использовать Option Explicit !

Option Explicit

Sub Word_tables_from_many_docx_to_Excel()
Dim myPath As String, myFile As String, myText As String
Dim xlRow As Long, xlCol As Long
Dim t As Table
Dim r As Row
Dim c As Cell
Dim xl As Object
 Set xl = CreateObject("excel.application")

 xl.Workbooks.Add
 xl.Visible = True

 'Here put your path where you have your documents to read:
 myPath = "C:\Temp\"  'End with '\'
 myFile = Dir(myPath & "*.docx")

 xlRow = 1
 Do While myFile <> ""
 Documents.Open myPath & myFile

  For Each t In ActiveDocument.Tables
     For Each r In t.Rows
        xlCol = 1
        For Each c In r.Range.Cells
           myText = c.Range.Text
           myText = Replace(myText, Chr(13), "")
           myText = Replace(myText, Chr(7), "")
           xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol) = myText
           xlCol = xlCol + 1
        Next c
        xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol + 1) = myFile
        xlRow = xlRow + 1
     Next r
     xlRow = xlRow + 1
  Next t

  ActiveWindow.Close False

 myFile = Dir
 Loop

End Sub