ReportReportReport
New Member
- Joined
- Feb 24, 2017
- Messages
- 1
I use a module (found on this site) to move footnotes in a word document to excel. It pulls Footnote number, page number and text and it a huge time saver. i often use ";" to denote a second source in a footnote(ex Source 1; Source 2; source 3) and i was hoping someone could help add some code that creates a second row or third row in excel for the extra sources.
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
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