Copiez les données de plusieurs fichiers MS Word vers Excel à l'aide de VBA
Je sais que cette question a déjà été posée ( Copie de données de plusieurs documents Word dans une feuille excel ) le fait est que je ne peux pas utiliser la réponse.
Je suis nouveau à VBA, mais je pensais pouvoir le gérer. J'avais tort. J'essayais d'utiliser le code fourni dans le fil mentionné pour analyser certains documents Word, d'abord avec quelques modifications, puis en utilisant simplement le code d'origine. Malheureusement, j'obtiens l'erreur d'exécution "objet requis".
Le code est fourni dessous. Les documents dont j'essaie d'obtenir des données sont des fichiers Word 2003 (j'ai d'abord essayé de changer le "docx" en "doc", puis d'enregistrer les documents dans docx et en utilisant le script d'origine, cela n'a pas aidé). Une chose est qu'ils sont en fait des documents papier numérisés et ocr'ed, donc...
a) la plupart des tables à l'intérieur sont conservées dans des cadres (je ne sais pas si cela change quoi que ce soit, soi-disant non, compte tenu de leur structure xml)
b) lorsque j'essaie de les enregistrer en tant que docx l'application en premier propose de les enregistrer en tant que rtfs. Alors peut-être qu'ils sont en fait des fichiers rtf, non.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: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