How to insert a sentence preceding endnote superscript into endnote

Question

The macro below was posted here and inserts "Page #." preceding each endnote:

Sub InsertPageNumberForEndnotes()
Dim endNoteCount As Integer
Dim curPageNumber As Integer
If ActiveDocument.Endnotes.Count > 0 Then
  For endNoteCount = 1 To ActiveDocument.Endnotes.Count
    Selection.GoTo What:=wdGoToEndnote, Which:=wdGoToAbsolute, _
      Count:=endNoteCount
    curPageNumber = Selection.Information(wdActiveEndPageNumber)
    ActiveDocument.Endnotes(endNoteCount).Range.Select
    ActiveDocument.Application.Selection.Collapse _
      (WdCollapseDirection.wdCollapseStart)
    ActiveDocument.Application.Selection.Paragraphs(1).Range.Characters(3)._
      InsertBefore "Page " & CStr(curPageNumber) & ". "        
  Next
End If    
End Sub

So for text with superscripts

Yak yak yak yak yak yak.^1 
       :
       :
Yuk yuk yuk yuk yuk yuk yuk.^2

The macro converts endnotes from

^1 Blah blah blah
^2 Blah blah blah 

Into

^1 Page 22. Blah blah blah
^2 Page 119. Blah blah blah

I'd now like add the sentence being referenced. So

^1 Page 22. Yak yak yak yak yak yak. Blah blah blah
^2 Page 119. Yuk yuk yuk yuk yuk yuk yuk. Blah blah blah

I see this done in several non-fiction books. Is it possible in a macro?

Answer 1

Here you go.

Sub AddSourceToEndNote()
    ' 04 Oct 2017

    Dim Note As EndNote
    Dim Txt As String, Tmp As String

    With ActiveDocument
        If .EndNotes.Count Then
            For Each Note In .EndNotes
                With Note
                    With .Reference
                        Txt = "Page" & Format(.Information(wdActiveEndPageNumber), " 0. ")
                        Tmp = .Sentences(1).Text
                        Do While Asc(Right(Tmp, 1)) < 31
                            Tmp = Left(Tmp, Len(Tmp) - 1)
                            If Len(Tmp) < 1 Then Exit Do
                        Loop
                        If InStr(".:?!", Right(Tmp, 1)) = 0 Then Tmp = Tmp & "."
                        Txt = Txt & Tmp
                    End With
                    With .Range
                        .Text = Txt & " " & .Text
                    End With
                End With
            Next Note
        End If
    End With
End Sub