Extract Footnotes from Word to Excel

The following will create a new workbook in which it inserts the footnote reference in the first column, the page on which the footnote appears in the second column and the text of the footnote in the third column

Sub ExtractFootnotes()

Dim xlapp As Object

Dim xlbook As Object

Dim xlsheet As Object

Dim i As Long, lognum As Long

Dim fnote As Footnote

On Error Resume Next

Set xlapp = GetObject(, "Excel.Application")

If Err Then

    bstartApp = True

    Set xlapp = CreateObject("Excel.Application")

End If

On Error GoTo 0

Set xlbook = xlapp.Workbooks.Add

Set xlsheet = xlbook.Worksheets(1)

With xlsheet.Range("A1")

    .Offset(0, 0).Value = "Foonote Ref"

    .Offset(0, 1).Value = "Page"

    .Offset(0, 2).Value = "Footnote Text"

    i = 1

    For Each fnote In ActiveDocument.Footnotes

        .Offset(i, 0).Value = fnote.Index

        .Offset(i, 1).Value = fnote.Range.Information(wdActiveEndPageNumber)

        .Offset(i, 2).Value = fnote.Range.Text

        i = i + 1

    Next fnote

End With

xlapp.visible = True

xlbook.Activate

Set xlapp = Nothing

Set xlbook = Nothing

Set xlsheet = Nothing

End Sub