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!!