Detect if space either side a bookmark, if not add them - vba

Question

I have several bookmarks in several Word Documents that need spaces added before and after all Bookmarks where a single space does not currently exist on either or both sides. I only want to be able to parse the current file.
I have tried several ways at doing this, several of which create infinate loops.
Using the following code, I have a level of success, however it creates an infinate loop in the process. I have tried looking through the Bookmark object, selecting each in turn and adding a space before and after, which causes spaces to be put within the bookmark or it ignores where the space should go and puts it after.
I have a macro that I run on the document that reveals the bookmarks and places it between more-than and less-than symbols like this "««bookmarkname»»" to make it easier to parse.
Here is my code:
Sub new_test()
Dim sT As String
Dim boo As Boolean
boo = False
Selection.Find.ClearFormatting
With Selection.Find
.Text = "««*»»[ ]"
.Forward = False
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
Do While .Execute
With Selection
'sT = Selection.Text
If (boo = False) Then
MsgBox "Added a character after bookmark"
Selection.InsertAfter (" ")
boo = True
End If
End With
boo = False
Loop
End With
End Sub

Answer 1

Ok - worked it out. Maybe it will prove of some use to someone.
Before I run this, I run another function over the document that reveals all of the bookmarks and puts more and less than signs around them like this: "««BOOKMARKNAME»»"
Sub bookmarks_ensure_space_beforeAfter()
' Before we can do any work, we need a list of bookmarks from the document
Dim bmks As Variant
bmks = create_array_of_bookmark_names() ' array of bookmark names
' This Assumes that there will not be more than 1000 bmks in the array fetched from the Word Doc
For i = 0 To 1000
If (bmks(i) <> "") Then
' if the 'bmk' is not null then process it
' there are likely to be several 100 that are empty
Dim wrd As String
Dim rng As Range
Call select_a_string("««" & bmks(i) & "»»") ' select the bookmark
wrd = "««" & bmks(i) & "»»"
Set rng = Selection.Range
' now move the cursor two places the left of the bookmark
Selection.MoveLeft Unit:=wdCharacter, count:=2
' now select the character infront of the cursor (which is now the character infront of the bmk)
Selection.MoveRight Unit:=wdCharacter, count:=1, Extend:=wdExtend
If (Selection.Text <> " ") Then
' if this character now selected is not a space - add one
rng.InsertBefore " "
End If
' now move the cursor to the right of the bookmark (using it's length as a character limit)
Selection.MoveRight Unit:=wdCharacter, count:=Len(wrd) + 1
' due to bookmarks being fiddly, recreate the same bmk directly after the original
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:=bmks(i)
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
' now we have a new bmk, select the character directly after the bmk)
Selection.MoveRight Unit:=wdCharacter, count:=1, Extend:=wdExtend
If (Selection.Text <> " ") Then
' if this character now selected is not a space - add one
rng.InsertAfter " "
End If
End If
Next
End Sub
Function create_array_of_bookmark_names() As Variant
' This function creates an array of bookmarks in the document and returns them as an array
Dim array_of_bmk(1000) As Variant
Dim c As Integer
c = 0
For Each mBookmark In ActiveDocument.Bookmarks()
array_of_bmk(c) = mBookmark.Name
c = c + 1
Next
' now return this array
create_array_of_bookmark_names = array_of_bmk
End Function
Sub select_a_string(str)
' This finds and selects a string of characters
Selection.Find.ClearFormatting
With Selection.Find
.Text = str
'.Replacement.Text = ""
.Forward = True
.MatchCase = True
.Wrap = wdFindContinue
.Format = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
End Sub