Sub ConvertTOC2Table()
Dim TOC As TableOfContents, Rng As Range, Tbl As Table 
Dim StrBkMkList As String, StrStlList As String, StrTmp As String, i As Long
With ActiveDocument
  If .Bookmarks.Exists("TblTOC") Then
    .Bookmarks("TblTOC").Range.Delete
    .Bookmarks("TblTOC").Delete
  End If
  Set TOC = .TablesOfContents.Add(Range:=.Range(0, 0), UseHeadingStyles:=True, IncludePageNumbers:=True)
  With TOC
    For i = 3 To .Range.Fields.Count
      StrBkMkList = StrBkMkList & "|" & Split(Trim(.Range.Fields(i).Code.Text), " ")(1)
      StrStlList = StrStlList & "|" & .Range.Paragraphs(i - 2).Style
    Next
    Set Rng = .Range
    .Delete
  End With
  Set Tbl = .Tables.Add(Range:=Rng, NumRows:=i - 2, NumColumns:=3)
  With Tbl
    .Borders.Enable = True
    .PreferredWidthType = wdPreferredWidthPercent
    .PreferredWidth = 90
    .Rows.Alignment = wdAlignRowCenter
    .Rows(1).HeadingFormat = True
    .Rows(1).Range.Style = "Strong"
    With .Columns(1)
      .PreferredWidthType = wdPreferredWidthPercent
      .PreferredWidth = 10
    End With
    With .Columns(2)
      .PreferredWidthType = wdPreferredWidthPercent
      .PreferredWidth = 70
    End With
    With .Columns(3)
      .PreferredWidthType = wdPreferredWidthPercent
      .PreferredWidth = 10
    End With
    With .Cell(1, 1).Range
      .Text = "Section"
    End With
    With .Cell(1, 2).Range
      .Text = "Subject"
    End With
    With .Cell(1, 3).Range
      .Text = "Page"
    End With
  End With
  For i = 1 To UBound(Split(StrBkMkList, "|"))
    StrTmp = Replace(Split(StrBkMkList, "|")(i), "Toc", "TblTOC")
    .Bookmarks.Add Name:=StrTmp, Range:=.Bookmarks(Split(StrBkMkList, "|")(i)).Range
    .Bookmarks(Split(StrBkMkList, "|")(i)).Delete
    Set Rng = Tbl.Cell(i + 1, 1).Range
    With Rng
      .Style = Split(StrStlList, "|")(i)
      .End = .End - 1
      .Fields.Add Range:=Rng, Type:=wdFieldEmpty, Text:="REF " & StrTmp & " \r \h", PreserveFormatting:=False
      .InsertBefore vbTab
    End With
    Set Rng = Tbl.Cell(i + 1, 2).Range
    With Rng
      .Style = Split(StrStlList, "|")(i)
      .End = .End - 1
      .Fields.Add Range:=Rng, Type:=wdFieldEmpty, Text:="REF " & StrTmp & " \h", PreserveFormatting:=False
    End With
    Set Rng = Tbl.Cell(i + 1, 3).Range
    With Rng
      .Style = Split(StrStlList, "|")(i)
      .End = .End - 1
      .Fields.Add Range:=Rng, Type:=wdFieldEmpty, Text:="PAGEREF " & StrTmp & " \h", PreserveFormatting:=False
      .InsertBefore vbTab
    End With
  Tbl.Range.Fields.Update
  'To not sort the table by topic/subject, comment out the next line
  Tbl.Sort ExcludeHeader:=True, FieldNumber:=2, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
  'To convert the table back to text, uncomment the next line
  'Tbl.ConvertToText Separator:=vbTab
  Next
End With
End Sub