Add/Replace bookmark in the footer

[Senad Isanovic]

Need to add a document markup at every footer in the doc. All sections
should be included. If the bookmark "bkDocMarkup" exists the value should be
replaced. If the bookmark does not exit it should be added to the footer.
This code is adding a value to the page footer but for some reason the same
value is added several times.

Sub assignBoomarkToTable()
Dim rgeFooter As Range
Dim strMarkupValue As String
Dim i As Long, j As Long
Dim rgeAllPages As Range

strMarkupValue = "DocID_" & Format(Date, "yyyymmdd") & Format(Time,
"hhmmss")
Application.ScreenUpdating = False
With ActiveDocument
For i = 1 To .Sections.Count
With .Sections(i)
.Footers(wdHeaderFooterPrimary).LinkToPrevious = True
If .PageSetup.DifferentFirstPageHeaderFooter Then
Set rgeAllPages =
..Footers(wdHeaderFooterFirstPage).Range.Paragraphs(1).Range
addBookmarkToFooter rgeAllPages, strMarkupValue
Set rgeAllPages = Nothing
End If

Set rgeAllPages =
..Footers(wdHeaderFooterPrimary).Range.Paragraphs(1).Range
addBookmarkToFooter rgeAllPages, strMarkupValue
Set rgeAllPages = Nothing

If .PageSetup.OddAndEvenPagesHeaderFooter Then
Set rgeAllPages =
..Footers(wdHeaderFooterEvenPages).Range.Paragraphs(1).Range
addBookmarkToFooter rgeAllPages, strMarkupValue
Set rgeAllPages = Nothing
End If
End With


Next i
End With
Application.ScreenUpdating = True
End Sub

Sub addBookmarkToFooter(rgeFooter As Range, strMarkupValue As String)

rgeFooter.Collapse wdCollapseStart

If rgeFooter.Bookmarks.Exists("bkDocMarkup") Then
rgeFooter.Bookmarks("bkDocMarkup").Range.Text = strMarkupValue
Else
rgeFooter.Text = strMarkupValue
ActiveDocument.Bookmarks.Add "bkDocMarkup", rgeFooter

End If

End Sub

 

[Russ]

Have you read the VBA help about the .LinkToPrevious property?

 

[Senad Isanovic]

Yes, but even if I remove that line of code the issue is stil the same. And
I have the same problem if I set LinkToPrevious = False

 

[Russ]

It says at the end of this article to overwrite an existing bookmark with
new text, then recreate the bookmark around the new text.

http://word.mvps.org/faqs/macrosvba/WorkWithBookmarks.htm


So you could amend your last sub like this:

Sub addBookmarkToFooter(rgeFooter As Range, strMarkupValue As String)

If rgeFooter.Bookmarks.Exists("bkDocMarkup") Then
rgeFooter.Bookmarks("bkDocMarkup").Range.Text = strMarkupValue
'destroys bookmark with new text
ActiveDocument.Bookmarks.Add "bkDocMarkup", rgeFooter
'bookmarks new text
Else
rgeFooter.Text = strMarkupValue
ActiveDocument.Bookmarks.Add "bkDocMarkup", rgeFooter
End Sub