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