Using Word VBA find Bold Text in a table cell and extract the text following it

0
votes

I have a table in Word. Word table cell I need to extract (using Excel VBA) the BOLD text from the cell to excel column, then extract the following text (not BOLD) upto the next BOLD text to the next Excel column Something like this and so on.. I tried the following but it select the whole cell, not the partial text I need. Any help is much appreciated.

  For Each wdCell In oDoc.Tables(1).Range.Cells
      Set myRange = wdCell.Range
      If nCol = 12 Then
         With myRange.Find
          .Text = ""
          .MatchCase = False
          .Replacement.Text = ""
          .Forward = True
          .wrap = wdFindContinue
          .Format = True
          .MatchWildcards = False
          .Font.Bold = True

         Do While .Execute
            If myRange.Find.Found Then
               Debug.Print "Bold text is found ->" & myRange.Text
               myRange.Select
               myRange.Start = myRange.End + 1
               myRange.End = wdCell.Range.End
               myRange.Select
               ActiveSheet.Cells(nRow, nCol) = WorksheetFunction.Clean(wdCell.Range.Text)
         Loop
       End With
   Next
1
excelvbams-wordword-table

1 Answers

1
votes

Perhaps something along the lines of:

Dim c As Long
With oDoc.Tables(1).Range
  With .Find
    .Text = ""
    .Replacement.Text = "^t^&^t"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWildcards = False
    .Font.Bold = True
    .Execute Replace:=wdReplaceAll
  End With
  For Each wdCell In .Cells
    With wdCell.Range
      If .Characters.First = vbTab Then .Characters.First.Delete
      .Copy
      ActiveSheet.Paste Destination:=ActiveSheet.Cells(wdCell.RowIndex, wdCell.ColumnIndex + c)
      If wdCell.ColumnIndex = 1 Then
        c = UBound(Split(.Text, vbTab))
      Else
        c = c + UBound(Split(.Text, vbTab))
      End If
    End With
  Next
End With