Excel Macro modification required to pull data from multiple Word docs and to address RUN TIME ERROR-CodePudding

I already have a Macro in Excel that pulls through data from specific tables, rows and columns in a specified Word doc and returns it to cells in my Excel s/sheet. I need to make 2 alterations to the code but my knowledge is not advanced enough.

I need to run this code on multiple Word docs in a specified folder, whether it is .doc or a .docx
I need to establish why on some Word docs, the code fails to pull through the data from the Word doc and I get RUN TIME ERROR CODE '4605' 'The method or property is not available because no text is selected'. I tried putting, 'on error resume next', at the start of the module so it keeps on running to the end, in the hope that some text would get pulled through, but still none of the cells in my Excel s/sheet get populated.

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

CodePudding user response：

RUN TIME ERROR CODE '4605' 'The method or property is not available because no text is selected'.

Runtime Code 4605 happens when Microsoft Word fails or crashes whilst it's running. It doesn't necessarily mean that the code was corrupt in some way, but just that it did not work during its run-time. This kind of error will appear as an annoying notification on your screen unless handled and corrected. Here are symptoms, causes and ways to troubleshoot the problem.

As the error message says there is no text selected. To find out what property or method gives the error message I'd recommend breaking the chain of calls in the single line of code by declaring each property or method call on a separate line, so you will know which call fails exactly.

CodePudding user response：

Your code may behave better if you avoid all that copy/paste and transfer the cell contents directly:

Sub ImportFromWord()
    
    Dim WordDoc As Word.Document, ws As Worksheet, WordApp As Word.Application
    
    Set ws = ActiveSheet 'or some other sheet

    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
    
    WordCellToExcel WordDoc.Tables(1).Cell(Row:=1, Column:=3), ws.Range("A3")
    WordCellToExcel WordDoc.Tables(4).Cell(Row:=3, Column:=6), ws.Range("B3")
    WordCellToExcel WordDoc.Tables(4).Cell(Row:=3, Column:=3), ws.Range("C3")
    'etc etc
    
    WordDoc.Close 'close Word doc
    WordApp.Quit ' close Word

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