Nested table question (W2003)

[ker_01]

This is a followup to my thread from the end of last week;

I'm working with a document format that someone else created, and I need to
extract the data from various table (and nested table) cells in a reliable
fashion.

I'm now able to determine what cell of a table I'm in, and at what level of
"nesting". There is one piece still eluding me. In this template, I have at
least one situation where the parent table has multiple nested tables *in the
same cell*. So in the parent table's cell (1,1) I have a 2x2 child table,
then some text in the parent table cell, then another 2x2 child table still
in that same parent cell.

If I am looping through every cell in every table, and then every cell in
every sub-table (in whatever order; I can re-arrange the data later), how do
I differentiate between child table 1 and child table 2 in the same parent
table cell?

My desired end product will be something like the following, but since I
don't know the Word object model, I'm backing into it:

For each table in document.tables
For each cell in table.cells
'For each subtable in table.cell ?
'For each cell in subtable ?
MyVariable = cell.range.text
'do my processing
'Next
'Next
Next
Next

I appreciate any suggestions!
Thank you,
Keith

Current code, which is designed just to verify the current location/table:

Sub LocationMacro()

Dim iSelectionRowEnd As Integer
Dim iSelectionRowStart As Integer
Dim iSelectionColumnEnd As Integer
Dim iSelectionColumnStart As Integer
Dim lngStart As Long
Dim lngEnd As Long
Dim lngNestLvl As Long
Dim pTableNumber As String

' Check if Selection IS in a table
' if not, exit Sub after message
If Selection.Information(wdWithInTable) = False Then
MsgBox "Selection is not in a table. Exiting macro."
Else
lngStart = Selection.Range.Start
lngEnd = Selection.Range.End
lngNestLvl = Selection.Cells.NestingLevel

' get the numbers for the END of the selection range
iSelectionRowEnd = Selection.Information(wdEndOfRangeRowNumber)
iSelectionColumnEnd = Selection.Information(wdEndOfRangeColumnNumber)

' collapse the selection range
Selection.Collapse Direction:=wdCollapseStart

' get the numbers for the END of the selection range
' now of course the START of the previous selection
iSelectionRowStart = Selection.Information(wdEndOfRangeRowNumber)
iSelectionColumnStart =
Selection.Information(wdEndOfRangeColumnNumber)

' RESELECT the same range
Selection.MoveEnd Unit:=wdCharacter, Count:=lngEnd - lngStart

' display the range of cells covered by the selection
MsgBox ActiveDocument.Range(0,
Selection.Tables(1).Range.End).Tables.Count & _
Chr(13) & Chr(13) & lngNestLvl & Chr(13) & Chr(13) & _
"The selection covers " & Selection.Cells.Count & " cells, from
Cell(" & _
iSelectionRowStart & "," & iSelectionColumnStart & ") to Cell(" & _
iSelectionRowEnd & "," & iSelectionColumnEnd & ")."
End If
End Sub

 

[Greg Maxey]

Perhaps something like this would work for you:

Sub CellContent()
Dim TopTbl As Table
Dim Nest1Tbl As Table 'First nesting level
Dim Nest2Tbl As Table 'Second nesting level
Dim ttCell As Word.Cell, nt1Cell As Word.Cell, nt2Cell As Word.Cell
Dim myVariable
For Each TopTbl In ActiveDocument.Tables
For Each ttCell In TopTbl.Range.Cells
If ttCell.Tables.Count > 0 Then
For Each Nest1Tbl In ttCell.Tables
For Each nt1Cell In Nest1Tbl.Range.Cells
If nt1Cell.Tables.Count > 0 Then
For Each Nest2Tbl In nt1Cell.Tables
For Each nt2Cell In Nest2Tbl.Range.Cells
myVariable = CellText(nt2Cell)
'Process myVariable
Next nt2Cell
Next Nest2Tbl
Else
myVariable = CellText(nt1Cell)
'Process myVariable
End If
Next nt1Cell
Next Nest1Tbl
Else
myVariable = CellText(ttCell)
'Process myVariable
End If
Next ttCell
Next TopTbl
End Sub

Function CellText(oCell As Word.Cell)
CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
End Function

 

[ker_01]

Wow! Greg, your code is amazing. I've already run it, and checked it against
a sample document. The only thing it seems to miss is the cell contents in a
parent table cell if there is a nested table present in that same cell
(probably just the ordering of the If statements). Once I figure that tidbit
out, then I can get into the real grunt work of comparing each cell to the
template to remove the original strings and only return the actual user entry
data from each cell.

Thank you very very much- and if you are ever around the Redmond area, I'll
buy you the beverage of your choice.

Thanks,
Keith

 

[ker_01]

I tried the simple answer of just grabbing the parent cell contents, but that
passes along the nested cell contents (all of them) as part of the parent
cell.

Is there a way to grab the parent cell contents and specifically exclude any
nested cells from that content?

Thank you!
Keith

Sub CellContent()
Dim TopTbl As Table
Dim Nest1Tbl As Table 'First nesting level
Dim Nest2Tbl As Table 'Second nesting level
Dim ttCell As Word.Cell, nt1Cell As Word.Cell, nt2Cell As Word.Cell
Dim myVariable
For Each TopTbl In ActiveDocument.Tables
For Each ttCell In TopTbl.Range.Cells
myVariable = CellText(ttCell) '<---return includes nested cell contents
'Process myVariable
If ttCell.Tables.Count > 0 Then
For Each Nest1Tbl In ttCell.Tables
For Each nt1Cell In Nest1Tbl.Range.Cells
If nt1Cell.Tables.Count > 0 Then
For Each Nest2Tbl In nt1Cell.Tables
For Each nt2Cell In Nest2Tbl.Range.Cells
myVariable = CellText(nt2Cell)
'Process myVariable
Next nt2Cell
Next Nest2Tbl
Else
myVariable = CellText(nt1Cell)
'Process myVariable
End If
Next nt1Cell
Next Nest1Tbl
Else
myVariable = CellText(ttCell)
'Process myVariable
End If
Next ttCell
Next TopTbl
End Sub

Function CellText(oCell As Word.Cell)
CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
End Function

 

[Greg Maxey]

AFAIK, the only thing to do is cobble something together so that any text in
a cell that is part of a nested table is stripped out. Something like this
perhaps:

Option Explicit
Sub CellContent()
Dim TopTbl As Table
Dim Nest1Tbl As Table 'First nesting level
Dim Nest2Tbl As Table 'Second nesting level
Dim ttCell As Word.Cell, nt1Cell As Word.Cell, nt2Cell As Word.Cell
Dim oRng As Word.Range
Dim i As Long
Dim myVariable
Set oRng = ActiveDocument.Range
oRng.Collapse wdCollapseEnd
ActiveDocument.Bookmarks.Add "ScratchPad", oRng
For Each TopTbl In ActiveDocument.Tables
For Each ttCell In TopTbl.Range.Cells
If ttCell.Tables.Count > 0 Then
Set oRng = ttCell.Range
oRng.MoveEnd wdCharacter, -1
oRng.Copy
Set oRng = ActiveDocument.Bookmarks("ScratchPad").Range
oRng.Paste
ActiveDocument.Bookmarks.Add "ScratchPad", oRng
For i = 1 To oRng.Tables.Count
oRng.Tables(i).Delete
Next i
myVariable = oRng.Text
MsgBox myVariable
For Each Nest1Tbl In ttCell.Tables
For Each nt1Cell In Nest1Tbl.Range.Cells
If nt1Cell.Tables.Count > 0 Then
Set oRng = nt1Cell.Range
oRng.MoveEnd wdCharacter, -1
oRng.Copy
Set oRng = ActiveDocument.Bookmarks("ScratchPad").Range
oRng.Paste
ActiveDocument.Bookmarks.Add "ScratchPad", oRng
For i = 1 To oRng.Tables.Count
oRng.Tables(i).Delete
Next i
myVariable = oRng.Text
MsgBox myVariable
For Each Nest2Tbl In nt1Cell.Tables
For Each nt2Cell In Nest2Tbl.Range.Cells
myVariable = CellText(nt2Cell)
MsgBox myVariable
Next nt2Cell
Next Nest2Tbl
Else
myVariable = CellText(nt1Cell)
MsgBox myVariable
End If
Next nt1Cell
Next Nest1Tbl
Else
myVariable = CellText(ttCell)
MsgBox myVariable
End If
Next ttCell
Next TopTbl
ActiveDocument.Bookmarks("ScratchPad").Range.Delete
End Sub
Function CellText(oCell As Word.Cell)
CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
End Function

 

[Greg Maxey]

Let's revise that a little:

Sub CellContent()
Dim TopTbl As Table
Dim Nest1Tbl As Table 'First nesting level
Dim Nest2Tbl As Table 'Second nesting level
Dim ttCell As Word.Cell, nt1Cell As Word.Cell, nt2Cell As Word.Cell
Dim myVariable
For Each TopTbl In ActiveDocument.Tables
For Each ttCell In TopTbl.Range.Cells
If ttCell.Tables.Count > 0 Then
myVariable = CellText(ttCell, True)
If Len(myVariable) > 0 Then
MsgBox myVariable
End If
For Each Nest1Tbl In ttCell.Tables
For Each nt1Cell In Nest1Tbl.Range.Cells
If nt1Cell.Tables.Count > 0 Then
myVariable = CellText(nt1Cell, True)
If Len(myVariable) > 0 Then
MsgBox myVariable
End If
For Each Nest2Tbl In nt1Cell.Tables
For Each nt2Cell In Nest2Tbl.Range.Cells
myVariable = CellText(nt2Cell, False)
MsgBox myVariable
Next nt2Cell
Next Nest2Tbl
Else
myVariable = CellText(nt1Cell, False)
MsgBox myVariable
End If
Next nt1Cell
Next Nest1Tbl
Else
myVariable = CellText(ttCell, False)
MsgBox myVariable
End If
Next ttCell
Next TopTbl
End Sub
Function CellText(oCell As Word.Cell, bFirstLook As Boolean)
Dim i As Long
Dim oRng As Word.Range
If bFirstLook Then
With ActiveDocument
.Range.InsertAfter vbCr
Set oRng = .Range
oRng.Collapse wdCollapseEnd
.Bookmarks.Add "ScratchPad", oRng
Set oRng = oCell.Range
oRng.MoveEnd wdCharacter, -1
oRng.Copy
Set oRng = .Bookmarks("ScratchPad").Range
oRng.Paste
.Bookmarks.Add "ScratchPad", oRng
For i = 1 To oRng.Tables.Count
oRng.Tables(i).Delete
Next i
CellText = oRng.Text
On Error Resume Next
.Bookmarks("ScratchPad").Range.Delete
.Paragraphs.Last.Previous.Range.Delete
On Error GoTo 0
End With
Else
CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
End If
End Function

 

[ker_01]

Thanks Greg! (You rock)

I was already starting to cobble something together, starting with the full
cell contents, then in each sub-loop, using Replace to replace the child
cell's string with a null string, thereby leaving only the parent cell string
by the end of the loop. I think I've almost got it working, but if I don't
get it soon I'll just abandon my attempt and use your rockin' code below.

When I first started this workaround I was doing it just for the learning, I
had hoped that there would be some part of the object model that would allow
the selection of just the parent layer of text
8-/

Thanks again for all your help!
Keith

 

[Greg Maxey]

There's a plan. Try:

Sub CellContent()
Dim TopTbl As Table
Dim Nest1Tbl As Table 'First nesting level
Dim Nest2Tbl As Table 'Second nesting level
Dim ttCell As Word.Cell, nt1Cell As Word.Cell, nt2Cell As Word.Cell
Dim myVariable
For Each TopTbl In ActiveDocument.Tables
For Each ttCell In TopTbl.Range.Cells
If ttCell.Tables.Count > 0 Then
myVariable = CellText(ttCell, True)
If Len(myVariable) > 0 Then
MsgBox myVariable
End If
For Each Nest1Tbl In ttCell.Tables
For Each nt1Cell In Nest1Tbl.Range.Cells
If nt1Cell.Tables.Count > 0 Then
myVariable = CellText(nt1Cell, True)
If Len(myVariable) > 0 Then
MsgBox myVariable
End If
For Each Nest2Tbl In nt1Cell.Tables
For Each nt2Cell In Nest2Tbl.Range.Cells
myVariable = CellText(nt2Cell, False)
MsgBox myVariable
Next nt2Cell
Next Nest2Tbl
Else
myVariable = CellText(nt1Cell, False)
MsgBox myVariable
End If
Next nt1Cell
Next Nest1Tbl
Else
myVariable = CellText(ttCell, False)
MsgBox myVariable
End If
Next ttCell
Next TopTbl
End Sub


Function CellText(oCell As Word.Cell, bFirstLook As Boolean)
Dim i As Long
Dim pStr As String
If bFirstLook Then
pStr = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
For i = 1 To oCell.Tables.Count
pStr = Replace(pStr, oCell.Tables(1).Range.Text, "")
Next i
CellText = pStr
Else
CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
End If
End Function

 

[Greg Maxey]

Better yet would be to call a recursive procedure that drills down to the
deepest nested tables:

Option Explicit
Dim myVariable
Sub Main()
Dim oTopTbl As Table
For Each oTopTbl In ActiveDocument.Tables
ProcessTables 1, oTopTbl
Next oTopTbl
End Sub

Sub ProcessTables(lngNestingLevel As Long, _
oTable As Word.Table, Optional ByRef oTableMajor As Word.Table)
Dim oCell As Word.Cell
Dim oTableMinor As Word.Table
For Each oCell In oTable.Range.Cells
myVariable = CellText(oCell, True)
If Len(myVariable) > 0 Then
MsgBox myVariable 'Do something with your variable
End If
If oCell.Tables.Count > 0 Then
For Each oTableMinor In oCell.Tables
lngNestingLevel = oTableMinor.NestingLevel
Set oTableMajor = oTableMinor
'Call recursive procedure to drill down to deepest nested table
ProcessTables lngNestingLevel, oTableMinor, oTableMajor
Next
End If
Next oCell
End Sub

Function CellText(oCell As Word.Cell, bFirstLook As Boolean)
Dim i As Long
Dim pStr As String
If bFirstLook Then
pStr = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
For i = 1 To oCell.Tables.Count
pStr = Replace(pStr, oCell.Tables(i).Range.Text, "")
Next i
CellText = pStr
Else
CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
End If
End Function

 

[Greg Maxey]

Just polishing the cannon ball now. There was some extraneous code in the
earlier versions:

Sub Main()
Dim oTopTbl As Table
For Each oTopTbl In ActiveDocument.Tables
ProcessTables oTopTbl
Next oTopTbl
End Sub

Sub ProcessTables(oTableMajor As Word.Table)
Dim oCell As Word.Cell
Dim oTableMinor As Word.Table
Dim pCellText As String
For Each oCell In oTableMajor.Range.Cells
'Extract cell text
pCellText = CellText(oCell, True)
If Len(pCellText) > 0 Then
MsgBox pCellText 'Do something with your variable
End If
If oCell.Tables.Count > 0 Then
For Each oTableMinor In oCell.Tables
Set oTableMajor = oTableMinor
'Call recursive procedure to drill down to deepest nested table
ProcessTables oTableMinor
Next
End If
Next oCell
End Sub

Function CellText(oCell As Word.Cell, bFirstLook As Boolean)
Dim i As Long
Dim pStr As String
If bFirstLook Then 'Exclude text contained in nested tables.
pStr = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
For i = 1 To oCell.Tables.Count
pStr = Replace(pStr, oCell.Tables(i).Range.Text, "")
Next i
CellText = pStr
Else
CellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
End If
End Function

 

[ker_01]

That is sweet code- I'm just a hack (never had any professional programming
training) so I'm happy just when things work... but I can appreciate the
gleam of my reflection in this elegant cannonball.

Keith

 

[Greg Maxey]

Keith,

Then we make a pair of hacks ;-). Glad I could help. If I ever come to
Redmond, I'll come be thirsty.