MS Word VBA. Getting Source object from Footnote field - vba

Question

In my document I must add footnotes to every formula i used. For example, I have some text with added Bibliography source
(something like "some very smart text [WrittenBySb]")
and I have formula
(for examle : E = mc2)
And after that formula I must add footnote contains source. I decided to write a macro that add footnote to formula with selected bibliography source:
Sub addFootnoteFromSelection()
Selection.MoveRight Unit:=wdCell 'my formula is in table - first row
'is null. second is actual formula and
'third contains actual formula's number
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
With Selection 'i want footnote mark to be in current
'formula's number
With .FootnoteOptions
.Location = wdBottomOfPage
.NumberingRule = wdRestartContinuous
.StartingNumber = 1
.NumberStyle = wdNoteNumberStyleArabic
End With
.Footnotes.Add Range:=Selection.Range, Reference:=""
End With
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.Style = ActiveDocument.Styles("Numer wzoru")
Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
End Sub
And that works, but I want to have full source name (like in bibliography field), not a citation mark.
I write a function in vba that returns proper looking and formatted string from Source field:
Function stringFromSource(curField As Source) As String
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
xmlDoc.LoadXML curField.XML
authors = "": title = "": publish = "": city = "": year = "": periodic =
""
'authors
Set surname = xmlDoc.getElementsByTagName("b:Last")
Set name = xmlDoc.getElementsByTagName("b:First")
Dim l As Integer
l = 0
For Each el In surname
If el.Text = "" Then Exit For
authors = authors + (el.Text & " " & name(l).Text & " ")
l = l + 1
Next el
'title
Set titlex = xmlDoc.getElementsByTagName("b:Title")
For Each el In titlex
If el.Text = "" Then Exit For
title = title + (el.Text & " ")
Next el
'publisher
Set pubx = xmlDoc.getElementsByTagName("b:Publisher")
For Each el In pubx
publish = publish + (el.Text & " ")
Next el
'city
Set cityx = xmlDoc.getElementsByTagName("b:City")
If cityx.Length = 0 Then city = city + ("(brak miasta)" & " ")
For Each el In cityx
city = city + (el.Text & " ")
Next el
'year
Set yearx = xmlDoc.getElementsByTagName("b:Year")
If yearx.Length = 0 Then year = year + ("(brak roku wydania)" & " ")
For Each el In yearx
year = year + (el.Text & " ")
Next el
'periodical title
Set periodx = xmlDoc.getElementsByTagName("b:PeriodicalTitle")
For Each el In period
periodic = periodic + (el.Text & " ")
Next el
Dim outputString As String
outputString = author & "- " & title & ", " & publish & periodic & ", " &
year
stringFromSource = outputString
End Function
This function works as expected. But I want to loop through all footnotes and convert it to string using my function:
Sub convertAllFootnotes()
Dim ftn As Footnote
Dim oRng As Range
For Each ftn In ActiveDocument.Footnotes
Set oRng = Selection.Range
oRng.Start = oRng.Start - 1
oRng.End = oRng.End + 1
oRng.Select
oRng.Text = stringFromSource(ftn) 'i don't know how to get source object
'from footnote
Next ftn
End Sub
And that is my problem. I don't know how to get Source object from footnote (that has Source object in it, this is not a static string but copied proper Source field)