Extract Word Table Data to Excel

[pankaj0718]

Hi!

I'm new to VBA and kind of need help with reading values from a word document (multiple tables with string and checkboxes in table cells)
I have this below code that I'm using to read the text from word tables and it works and it gets the text values. But the checkbox values are not being fetched (fetched as blank).

Can some one please help?

Here is the code I'm using

Sub Test()


Dim wdDoc As Object
Dim wdFileName As Variant
Dim tableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim resultRow As Long
Dim tableStart As Integer
Dim tableTot As Integer
Dim wkSht As Worksheet


On Error Resume Next


ActiveSheet.Range("A:AZ").ClearContents


wdFileName = Application.GetOpenFilename("Word files (*.doc),*.docx", , _
"Browse for file containing table to be imported")


If wdFileName = False Then Exit Sub '(user cancelled import file browser)


Set wdDoc = GetObject(wdFileName) 'open Word file


With wdDoc
    tableNo = wdDoc.Tables.Count
    tableTot = wdDoc.Tables.Count
    If tableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    'ElseIf tableNo > 1 Then
     '   tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
      '  "Enter the table to start from", "Import Word Table", "1")
    End If


    resultRow = 1


    For tableStart = 7 To tableTot
        With .Tables(tableStart)
            'copy cell contents from Word table cells to Excel cells
            For iRow = 1 To .Rows.Count
                For iCol = 1 To .Columns.Count
                    wkSht.Cells(resultRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
                Next iCol
                
                With wkSht
                .Range(.Cells(resultRow, 1), .Cells(resultRow, iCol)).Interior.ColorIndex = 15
                End With
                
                resultRow = resultRow + 1
            Next iRow
        End With
        'resultRow = resultRow + 1
    Next tableStart
End With


End Sub

I stumbled across below code but not sure how to integrate it with my current code

Function CellGetText(ByRef oCell As Word.Cell) As String


    Dim oRng As Word.Range
    Dim strTemp As String
    Dim oChr As Range
    Dim lngIndex As Long
    Dim off As FormField
    lngIndex = 1
    Set oRng = oCell.Range
    oRng.MoveEnd wdCharacter, -1
    Debug.Print oRng.Text
    For Each oChr In oRng.Characters
        Select Case Asc(oChr)
        Case 21
            Set off = oRng.FormFields(lngIndex)
            If off.CheckBox.Value = True Then
                strTemp = strTemp & "true"
            Else
                strTemp = strTemp & "false"
            End If
            lngIndex = lngIndex + 1
        Case Else
            strTemp = strTemp & oChr
        End Select
    Next oChr
    CellGetText = strTemp


End Function

Thanks a lot for help!!