问从多个Word文档中提取数据和解决运行时错误代码“4605”所需的Excel宏修改

EN

Sub ImportFromWord()
    Const FLDR_PATH As String = "C:\Temp\Docs\"
    Dim WordDoc As Word.Document, WordApp As Word.Application
    Dim rw As Range, f
    
    Set rw = ActiveSheet.Rows(3) 'or some other sheet

    f = Dir(FLDR_PATH & "*.doc*") 'check for document
    Do While Len(f) > 0
        
        If WordApp Is Nothing Then 'open word if not already open
            Set WordApp = CreateObject("word.application")
            WordApp.Visible = False
        End If
        
        With WordApp.Documents.Open(FLDR_PATH & f, ReadOnly:=True) ' open Word file
        
            WordCellToExcel .Tables(1).Cell(Row:=1, Column:=3), rw.Cells(1)
            WordCellToExcel .Tables(4).Cell(Row:=3, Column:=6), rw.Cells(2)
            WordCellToExcel .Tables(4).Cell(Row:=3, Column:=3), rw.Cells(3)
            'etc etc
            .Close savechanges:=False
        End With
        
        Set rw = rw.Offset(1) 'next row down
        f = Dir()             'next file, if any
    Loop
    
    If Not WordApp Is Nothing Then WordApp.Quit ' close Word if it was opened

End Sub

'transfer content from a cell in a Word Table to an Excel range
Sub WordCellToExcel(wdCell As Word.Cell, destCell As Range)
    Dim v
    v = wdCell.Range.Text
    destCell.Value = Left(v, Len(v) - 2) 'remove "end of cell" marker
End Sub