Sub CreateTOCofFootnotes_CurrentSection()
Dim oSec As Section
Dim colTCFields As New Collection
  Set oSec = ActiveDocument.Sections(Selection.Information(wdActiveEndSectionNumber))
  ScanSectionFootNotes oSec, colTCFields
  InsertTableOfContents colTCFields
lbl_Exit:
  Exit Sub
End Sub

Sub InsertTableOfContents(colTCFields As Collection)
Dim oRng As Range
Dim lngIndex As Long
Dim strEntry As String
  For lngIndex = 1 To colTCFields.Count
    Set oRng = colTCFields(lngIndex).Code
    strEntry = Right(oRng.Text, Len(oRng.Text) - 5)
    Selection.TypeText strEntry & " - " & oRng.Information(wdActiveEndAdjustedPageNumber) & vbCr
  Next lngIndex
lbl_Exit:
  Exit Sub
End Sub

Sub ScanSectionFootNotes(oSec As Section, colTCFields As Collection)
Dim oFN As Footnote
Dim oField As Field
  For Each oFN In oSec.Range.Footnotes
    For Each oField In oFN.Range.Fields
      If oField.Type = wdFieldTOCEntry Then
        colTCFields.Add oField
      End If
    Next oField
  Next oFN
lbl_Exit:
  Exit Sub
End Sub