Копирование данных из нескольких файлов MS Word в Excel с помощью VBA

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

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

код предоставляется ниже. Документы, из которых я пытаюсь получить данные, - это файлы Word 2003 (сначала я попытался изменить "docx" на "doc", а затем сохранить документы в docx и использовать исходный скрипт, не помогло). Одно дело, что они на самом деле отсканированные и ocr'Ed бумажные документы, так...

a) большинство таблиц внутри хранятся во фреймах (не знаю, изменяет ли он что-нибудь, якобы нет, учитывая их структуру xml)

b) когда я пытаюсь их спасти в качестве docx приложение сначала предлагает сохранить их как rtfs. Так что, может быть, они на самом деле файлы rtf, а не .док?

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:somepath"  '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
11
задан Community
06.05.2023 10:20 Количество просмотров материала 3488
Распечатать страницу

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
3
отвечен ZygD 2023-05-07 18:08

Постоянная ссылка на данную страницу: [ Скопировать ссылку | Сгенерировать QR-код ]

Ваш ответ

Опубликуйте как Гость или авторизуйтесь

Имя
Мы используем cookie. Это позволяет нам анализировать взаимодействие посетителей с сайтом и делать его лучше. Продолжая пользоваться сайтом, вы соглашаетесь с использованием файлов cookie. Политика конфиденциальности
Согласен
Вверх