คัดลอกข้อมูลจากไฟล์ MS Word หลายไฟล์ไปยัง Excel โดยใช้ VBA

ฉันรู้ว่าคำถามนี้ถูกถามแล้ว (การคัดลอกข้อมูลจากเอกสารคำหลายคำไปยังแผ่นงาน excel ) สิ่งที่ฉันไม่สามารถใช้คำตอบ

ฉันสดชื่นกับ VBA แต่ฉันคิดว่าฉันสามารถจัดการกับมันได้ ฉันผิดไป. ฉันพยายามใช้รหัสที่มีให้ในเธรดที่กล่าวถึงเพื่อแยกเอกสาร Word ในตอนแรกด้วยการแก้ไขบางอย่างจากนั้นเพียงแค่ใช้รหัสต้นฉบับ น่าเสียดายที่ฉันได้รับข้อผิดพลาด "ต้องใช้วัตถุ"

รหัสที่ให้ไว้ด้านล่าง เอกสารที่ฉันพยายามรับข้อมูลคือไฟล์ Word 2003 (ก่อนอื่นฉันพยายามเปลี่ยน "docx" เป็น "doc" จากนั้นบันทึกเอกสารใน docx และใช้สคริปต์ต้นฉบับไม่ช่วย) สิ่งหนึ่งที่พวกเขามีในความเป็นจริงการสแกนและ ocr'ed เอกสารที่เป็นกระดาษเพื่อให้ ...
ก)มากที่สุดของตารางที่อยู่ภายในจะถูกเก็บไว้ในกรอบ (ไม่ทราบว่ามีการเปลี่ยนแปลงอะไรที่คาดคะเนไม่พิจารณาโครงสร้าง 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

ฉันได้ทำการทดสอบแล้ว มันใช้งานได้ดีจริง ๆ มีหลายประเด็นที่ควรคำนึงถึงก่อนใช้รหัสรุ่นปัจจุบัน:

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