Create Bookmarks automatically

Question

I have word documents that contains the following structure :

Civil Law number 00005 date 12/5/2005

constitution number 00009 date 12/12/2000

the number and date will change there are not always as stated in my example

I need to create  bookmarks automatically every time word reads the above structure

so far I did the following :

Sub bookmarks()

Dim i As Long

  Dim j As Long

  i = 0

  Selection.HomeKey wdStory

  With Selection.Find

    Do While .Execute(FindText:="Civil", Forward:=True, _

        MatchWildcards:=False, Wrap:=wdFindStop, MatchCase:=False) = True

      i = i + 1

      ActiveDocument.bookmarks.Add "BK_TM" & i, Selection.Range

      Selection.Collapse wdCollapseEnd

    Loop

  End With

  End Sub

but the thing with the macro I wrote is that it will create bookmarks for all the words "Civil" and what I want is the structure I listed above not only the word civil  as it will not create bookmarks for Constitution structure as well

help please

Answer 1

Hi Anfy,

The Find/Replace code assumes an english-language system (or another language that uses commas as separators). Depending on your regional settings, you may need to change:

vFindText = Array("Civil Law number [0-9]{5,} date [0-9]{1,2}/[0-9]{1,2}/[0-9]{4}", _

                  "constitution number [0-9]{5,} date [0-9]{1,2}/[0-9]{1,2}/[0-9]{4}")

to:

vFindText = Array("Civil Law number [0-9]{5;} date [0-9]{1;2}/[0-9]{1;2}/[0-9]{4}", _

                  "constitution number [0-9]{5;} date [0-9]{1;2}/[0-9]{1;2}/[0-9]{4}")

Answer 2

The following will work, provided your references are as shown vis-à-vis capitalisation and spacing and the references are in the body of the document.

The case of the found text in the Array is matched exactly. The macro also assumes a number of at least 5 digits. If you may have a lower number of digits change the instances of {5,}.

Sub BookmarkReferences()

Dim vFindText

Dim oRng As Range

Dim i As Long, j As Long

j = 1

vFindText = Array("Civil Law number [0-9]{5,} date [0-9]{1,2}/[0-9]{1,2}/[0-9]{4}", _

                  "constitution number [0-9]{5,} date [0-9]{1,2}/[0-9]{1,2}/[0-9]{4}")

For i = 0 To UBound(vFindText)

    Set oRng = ActiveDocument.Range

    With oRng.Find

        .Text = vFindText(i)

        Do While .Execute(Forward:=True, MatchWildcards:=True) = True

            oRng.Bookmarks.Add "BK_TM" & j, oRng

            j = j + 1

        Loop

    End With

Next

End Sub

Answer 3

Yes Macropod

this is what I copied from Graham :

Sub BookmarkReferences()

Dim vFindText

Dim oRng As Range

Dim i As Long, j As Long

j = 1

vFindText = Array("Civil Law number [0-9]{5,} date [0-9]{1,2}/[0-9]{1,2}/[0-9]{4}", _

                  "constitution number [0-9]{5,} date [0-9]{1,2}/[0-9]{1,2}/[0-9]{4}")

For i = 0 To UBound(vFindText)

    Set oRng = ActiveDocument.Range

    With oRng.Find

        .Text = vFindText(i)

        Do While .Execute(Forward:=True, MatchWildcards:=True) = True

            oRng.bookmarks.Add "BK_TM" & j, oRng

            j = j + 1

        Loop

    End With

Next

End Sub

then I opened word 2003 document containing only :

Civil Law number 00005 date 12/5/2005

constitution number 00009 date 12/12/2000

 and tested the macro on it

Answer 4

Hi Anfy,

Graham's code works fine for me. Are you sure you've copied it correctly?

Answer 5

Dear Graham

while executing the code 

im getting the bellow error :

The Find what text contains a pattern Match Expression wich is not valid

and when I click the debug button im getting :

Do While .Execute(Forward:=True, MatchWildcards:=True) = True

highlighted in yellow

help please