Hyperlinked text in Word footers to a selected bookmark - vba

Question

I wanted a custom footer in all my documents with a hyperlinked text to a bookmark in same document. i.e. 'Top Of Document' kind of link in all the footers. I had to collect information for all over the places to achieve this much. and wanted to share here so others do not have to fight for this thing all at once.
So far from all the question & suggestions from stackoverflow and other sites, I have achieved this much-
Created a macro to create a bookmark automatically, of a selected text in document.
Bookmark will be re-created (delete and create) if its already present
Macro will add a new footer with page number and a text with delimiter (i.e. / Hit Overview).
Now I want to create this text in footer a HyperLink to the bookmark. code is simple. but i guess i am doing something wrong, tried by creating a HyperLink object. but not working. please suggest something.
Here is the macro function-
Sub InsertFootnote()
Const wdAlignPageNumberCenter = 1
Dim varNumberPages As Variant
varNumberPages = ActiveDocument.Content.Information(wdActiveEndAdjustedPageNumber)
' Delete bookmark if any with this name
If ActiveDocument.Bookmarks.Exists("HitOverviewMac") = True Then
ActiveDocument.Bookmarks("HitOverviewMac").Delete
End If
' Create a Bookmark to the selected text
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="HitOverviewMac"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Dim mHlink As Hyperlink
Dim i As Long
For i = 1 To ActiveDocument.Sections.Count
With ActiveDocument.Sections(i)
' Remove footer
'.Footers(wdHeaderFooterPrimary).Range.Text = ""
'.Footers(wdHeaderFooterPrimary).PageNumbers.Add (wdAlignPageNumberCenter)
'.Footers(wdHeaderFooterPrimary).Range.InsertBefore "Hit Overview / Page "
.Footers(wdHeaderFooterPrimary).Range.Select
With Selection
If ActiveDocument.Bookmarks.Exists("HitOverviewMac") = True Then
.Paragraphs(1).Alignment = wdAlignParagraphCenter
.TypeText Text:="Page "
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"PAGE ", PreserveFormatting:=True
.TypeText Text:=" of "
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"NUMPAGES ", PreserveFormatting:=True
.EndKey Unit:=wdLine
.TypeText Text:=" ~ "
ActiveDocument.Hyperlinks.Add Anchor:=.Range, Address:="", _
SubAddress:="HitOverview", ScreenTip:="", TextToDisplay:="Hit Overview"
Else
MsgBox "Bookmark does not exists"
End If
End With
End With
Next
End Sub

Answer 1

Ok, Its wasn't the problem with Macro(except below), its the problem with couple of Documents I was testing with.
few mistakes that I missed - SubAddress:="BOOKMARK_NAME" AND Anchor:=Selection.Range.
So the problem occurs if any Doc already has some text in footers. and so that now I am removing footer first.
Here is the Code for everyone's reference-
Sub InsertFootnote()
Const wdAlignPageNumberCenter = 1
Dim varNumberPages As Variant
varNumberPages = ActiveDocument.Content.Information(wdActiveEndAdjustedPageNumber)
If ActiveDocument.Bookmarks.Exists("HitOverviewMac") = True Then
ActiveDocument.Bookmarks("HitOverviewMac").Delete
End If
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="HitOverviewMac"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Dim mHlink As Hyperlink
Dim i As Long
For i = 1 To ActiveDocument.Sections.Count
With ActiveDocument.Sections(i)
.Footers(wdHeaderFooterPrimary).Range.Text = ""
.Footers(wdHeaderFooterPrimary).PageNumbers.Add (wdAlignPageNumberCenter)
.Footers(wdHeaderFooterPrimary).Range.Select
With Selection
If ActiveDocument.Bookmarks.Exists("HitOverviewMac") = True Then
.Paragraphs.Alignment = wdAlignParagraphCenter
.TypeText Text:="Page "
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"PAGE ", PreserveFormatting:=True
.TypeText Text:=" of "
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"NUMPAGES ", PreserveFormatting:=True
.EndKey Unit:=wdLine
.TypeText Text:=" / "
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
SubAddress:="HitOverviewMac", ScreenTip:="", TextToDisplay:="Hit Overview"
Else
MsgBox "Bookmark does not exists"
End If
End With
End With
Next
End Sub