需要修改 Excel 宏才能从多个 Word 文档中提取数据并解决运行时错误代码“4605”

Question

我在 Excel 中已经有一个宏，可以从指定的 Word 文档中的特定表、行和列中提取数据，并将其返回到我的 Excel/工作表中的单元格。我需要对代码进行 2 处修改，但我的知识还不够先进。

1. 我需要在指定文件夹中的多个Word文档上运行此代码，无论是.doc还是.docx

2. 我需要确定为什么在某些 Word 文档上，代码无法从 Word 文档中提取数据，并且我收到运行时错误代码“4605”“该方法或属性不可用，因为没有选择文本”。我尝试将“on error resume next”放在模块的开头，以便它继续运行到最后，希望某些文本能够被拉出来，但我的 Excel s/sheet 中仍然没有一个单元格得到人口稠密。

Sub ImportFromWord()

On Error Resume Next

  'Activate Word Object Library

  Dim WordDoc As Word.Document

  Set WordApp = CreateObject("word.application") ' Open Word session

  WordApp.Visible = False 'keep word invisible
  Set WordDoc = WordApp.Documents.Open("C:\Users\brendan.ramsey\OneDrive - Ofcom\Objectives\Brendan's Objectives 2022-23\Licence calls\test 2.docx") ' open Word file

  'copy third row of first Word table
  WordDoc.Tables(1).Cell(Row:=1, Column:=3).Range.Copy

  'paste in Excel
  Range("A3").PasteSpecial xlPasteValues
  
  WordDoc.Tables(4).Cell(Row:=3, Column:=6).Range.Copy
  Range("B3").PasteSpecial xlPasteValues
  
  WordDoc.Tables(4).Cell(Row:=3, Column:=3).Range.Copy
  Range("C3").PasteSpecial xlPasteValues
  
  WordDoc.Tables(5).Cell(Row:=2, Column:=5).Range.Copy
  Range("D3").PasteSpecial xlPasteValues
  
  WordDoc.Tables(5).Cell(Row:=2, Column:=7).Range.Copy
  Range("E3").PasteSpecial xlPasteValues
  
  WordDoc.Tables(5).Cell(Row:=2, Column:=2).Range.Copy
  Range("F3").PasteSpecial xlPasteValues



  WordDoc.Close 'close Word doc
  WordApp.Quit ' close Word

End Sub

Answer 1

如果您避免所有复制/粘贴并直接传输单元格内容，您的代码可能会表现得更好：

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

Answer 2

运行时错误代码“4605”“该方法或属性不可用，因为未选择任何文本”。

当 Microsoft Word 在运行时失败或崩溃时，会出现运行时代码 4605。这并不一定意味着代码在某种程度上被损坏，而只是意味着它在运行时无法工作。除非得到处理和纠正，否则此类错误将在屏幕上显示为烦人的通知。以下是症状、原因以及解决问题的方法。

正如错误消息所示，没有选择任何文本。要找出哪些属性或方法给出了错误消息，我建议通过在单独的行上声明每个属性或方法调用来打破单行代码中的调用链，这样您就可以准确地知道哪个调用失败了。