Copy table data from Word to Excel

Help Activities
, , , ,
1

Hello Guys,

I need to get/ copy table data from Word document to excel and I’m using below code, but that’s failing to get me the output sometimes. Could any one fix it (if needs to be modified) or provide me any other code to achieve the same?

Reason for using this code apart from what is already available/ provided in other posts:

  • This below is not losing the Bullet points/ “*”'s in the data when extracted (which are needed) and also not treating the spaces between each point/ line in a table cell to be a different row/ cell item.
  • This below code is working 70 - 90% of the times as per my need (how I like the output to be) but rest it is giving “Error 438 - object does not support the property or method”

Thanks in advance.

Sub CopyTables(in_DocFilePath As String, in_ExcelFilePath As String)
    Dim oWord As Word.Application
    Dim WordNotOpen As Boolean
    Dim oDoc As Word.Document
    Dim oTbl As Word.Table
    Dim fd As Office.FileDialog
    Dim FilePath As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
   
   FilePath = in_DocFilePath
    
    On Error Resume Next
   
    Application.ScreenUpdating = False
   
    ' Create new workbook
    Set wbk = Workbooks.Add(Template:=xlWBATWorksheet)
   
    ' Get or start Word
    Set oWord = GetObject(Class:="Word.Application")
    If Err Then
        Set oWord = New Word.Application
        WordNotOpen = True
    End If
   
    On Error GoTo Err_Handler
   
    ' Open document
    Set oDoc = oWord.Documents.Open(Filename:=FilePath)
    ' Loop through the tables
    For Each oTbl In oDoc.Tables
        ' Create new sheet
        Set wsh = wbk.Worksheets.Add(After:=wbk.Worksheets(wbk.Worksheets.Count))
        ' Copy/paste the table
        oTbl.Range.Copy
        wsh.Paste
    Next oTbl
   
    ' Delete the first sheet
    Application.DisplayAlerts = False
    wbk.Worksheets(1).Delete
    Application.DisplayAlerts = True
    wbk.SaveAs Filename:=in_ExcelFilePath, FileFormat:=xlOpenXMLWorkbook
    wbk.Close
    wbk.Quit
    oDoc.Close
    oDoc.Quit
    
   
Exit_Handler:
    On Error Resume Next
    oDoc.Close SaveChanges:=False
    If WordNotOpen Then
        oWord.Quit
    End If
    'Release object references
    Set oTbl = Nothing
    Set oDoc = Nothing
    Set oWord = Nothing
    Application.ScreenUpdating = True
    Exit Sub
   
Err_Handler:
    MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error: " & Err.Number
    Resume Exit_Handler
End Sub
2

Can you please elaborate more what issue you are facing exactly?

3

Hello @Akash_Javalekar1, it gives me an error like “Method ‘Paste’ of object ‘_Worksheet’ failed” for 3 files out of 25 I tested with and every time it’s for a random file. I looked up the error and it turns out that ‘Paste’ method cannot handle huge data or data with extra formatting.
However, I do not see much formatting in it.

Anyway, I’ve modified it a little and it is working now without any issues. I’ll post the updated code if it turns out well post load testing.

Thank you.

4

Hi @Vamsi_Krishna_Gogineni let me know if you need any help

5

Sure. Thank you, @Akash_Javalekar1