需要修改Excel宏，以便从多个Word文档中提取数据并解决运行时错误代码'4605'

ddrv8njm 于 2022-11-18 发布在其他

关注(0)|答案(2)|浏览(533)

我已经有一个Excel中的宏，通过从特定的表，行和列中的数据在指定的Word文档中提取，并将其返回到我的Excel S/工作表中的单元格。我需要做2修改代码，但我的知识还不够先进。
1.我需要在指定文件夹中的多个Word文档上运行此代码，无论是.doc还是.docx
1.我需要建立为什么在一些Word文档，代码无法通过从Word文档的数据拉，我得到运行时错误代码“4605”“该方法或属性不可用，因为没有选择文本”.我试着把，“在错误恢复下一个”，在模块的开始，所以它一直运行到最后，希望一些文本会被拉，但Excel/工作表中的单元格仍然没有填充。

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

excel

来源：https://stackoverflow.com/questions/74348598/excel-macro-modification-required-to-pull-data-from-multiple-word-docs-and-to-ad

2条答案

按热度按时间

holgip5t1#

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

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

赞(0）回复(0）举报 2022-11-18

1aaf6o9v2#

运行时错误代码“4605”“由于未选择文本，该方法或属性不可用”。
运行时代码4605发生时，Microsoft Word失败或崩溃，而它的运行。这并不一定意味着代码已损坏在某种程度上，但只是它没有工作，在其运行时。这种错误将出现在您的屏幕上恼人的通知，除非处理和更正。以下是症状，原因和方法来解决该问题。
因为错误信息显示没有选择文本。要找出哪个属性或方法给出了错误信息，我建议在单独的一行代码中声明每个属性或方法调用，从而中断单行代码中的调用链，这样您就可以确切地知道哪个调用失败了。

赞(0）回复(0）举报 2022-11-18

我来回答

需要修改Excel宏，以便从多个Word文档中提取数据并解决运行时错误代码'4605'

2条答案

相关问题

热门标签

最新问答