Option Explicit 
Dim FpVM As FpPageViewMode 
Dim objBody As FPHTMLBody 
Dim objUL As FPHTMLUListElement 
Dim objHdEl As FPHTMLHeaderElement 
Dim strUL As String 
Dim strTemp As String 
Dim i As Integer 
Const DQ As String = """" 
 
Sub TOC() 
     ' remember the viewmode
    FpVM = ActivePageWindow.ViewMode 
     ' go to normal view
    ActivePageWindow.ViewMode = fpPageViewNormal 
     
     ' save reference to body element
    Set objBody = ActiveDocument.body 
     
     ' save reference to ul element where id = "TOC" (if it exists)
    For Each objUL In objBody.all.tags("ul") 
        If objUL.Id = "TOC" Then 
            Exit For 
        Else 
            Set objUL = Nothing 
        End If 
    Next objUL 
     
     ' start building new TOC
    strUL = "<ul id=" & DQ & "TOC" & DQ & ">" 
     
     ' loop through all "h2" tags
    For Each objHdEl In objBody.all.tags("h2") 
         
         ' counter to give a unique name to each "a" tag
        i = i + 1 
         
         ' if objHdEl already contains an "a" tag, delete it
        If Not objHdEl.all.tags("a").Item(0) Is Nothing Then 
            objHdEl.all.tags("a").Item(0).outerHTML = "" 
        End If 
         
         ' save the innerHTML of the "h2" tag
        strTemp = objHdEl.innerHTML 
         
         ' change the innerHTML of the "h2" tag
        objHdEl.innerHTML = "<a name=" & DQ & "id" & i & DQ & "></a>" & strTemp 
         
         ' append new list item to the TOC
        strUL = strUL & vbCrLf & "  <li><a href=" & DQ & "#id" & i 
        strUL = strUL & DQ & ">" & strTemp 
        strUL = strUL & "</a></li>" 
         
    Next objHdEl 
     
     ' closing the "ul" element
    strUL = strUL & vbCrLf & "</ul>" & vbCrLf 
     
    If objUL Is Nothing Then 
         ' add TOC (after first "h1" tag)
        On Error Resume Next 'continue if no tags are present.
        objBody.all.tags("h1").Item(0).insertAdjacentHTML "afterEnd", vbCrLf & strUL 
    Else 
         ' update TOC (wherever it is located)
        objUL.outerHTML = strUL 
    End If 
     
     ' return to previous viewmode
    ActivePageWindow.ViewMode = FpVM 
     
End Sub