Copie dados de vários arquivos do MS Word para o Excel usando o VBA

Question

Eu sei que essa pergunta já foi feita ( Copiando dados de vários documentos do Word em uma única planilha do Excel ), não posso usar a resposta.

Sou novo no VBA, mas achei que posso lidar com isso. Eu estava errado. Eu estava tentando usar o código fornecido no thread mencionado para analisar alguns documentos do Word, primeiro com algumas alterações, em seguida, apenas usando o código original. Infelizmente, recebo o erro de tempo de execução "objeto necessário".

O código é fornecido abaixo. Os documentos dos quais estou tentando obter dados são arquivos do Word 2003 (primeiro tentei alterar o "docx" para "doc" e, em seguida, salvar os documentos no docx e usar o script original, não ajudou). Uma coisa é que eles são de fato digitalizados e escritos em papel, então ...
a) a maioria das tabelas dentro é mantida em quadros (não sei se muda alguma coisa , supostamente não, considerando sua estrutura xml)
b) quando tento salvá-los como docx o aplicativo primeiro propõe salvá-los como rtfs. Então, talvez eles sejam, na verdade, arquivos rtf, não .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

Eu testei isso. Na verdade funciona bem. Vários pontos em mente antes de usar a versão atual do código:

1. Ele deve ser adicionado ao Word VBA, não ao Excel ou outro (essa pode ser a razão pela qual você recebeu o erro "objeto necessário").
2. Ele processa apenas .docx
3. Ele processa todas as tabelas reais do MS Word, não imagens que podem se parecer com tabelas.

Eu modifiquei um pouco o código para torná-lo um pouco mais legível, pelo menos para mim, vindo do mundo do Excel VBA. Você deve sempre usar 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