Adding bookmarks in VBA in a specific place

[Lisa]

I have several templates. I'm going to be inserting a template into
another template. All the templates have bookmarks in them. As you
know, Word will not insert a bookmark with the same name. So when the
new template is inserted, the bookmark is not. I need code to check to
see if there is a bookmark at every place needed(every job number) and
if there is not one, add one so that a typist can put the job number
in.

DMIJOB#Bookmark needs to be here)


After this is done, the patient name and job number will be exported
to a text file. I got this code from another post, but need help
getting the bookmarks by the job numbers.(it just adds it where the
cursor is)

Private Sub InsertBookmark(JobNumbers As String)

' Utility code used by the Insert macros below
If ActiveDocument.Bookmarks.Exists(JobNumbers) = True Then
ActiveDocument.Fields.Add Range:=Selection.Range, _
Type:=wdFieldRef, Text:=JobNumbers
Else
ActiveDocument.Bookmarks.Add Name:="JobNumbers", _
Range:=Selection.Range
End If

End Sub

Thanks!

 

[Greg Maxey]

Lisa,

What do you mean by I am going to be inserting a template into another
template?

Is "JobNumber" the same number each place it appears in the final
document? If so, then you only need one bookmark named "JobNumber."
The rest of the places JobNumber data needs to appear should be REF
fields.

What is you complete code that you are using now?

 

[Lisa]

Greg,
Thanks for your reply! This is for the dictation of jobs. The inserts
are going to be for the next job, hence a multi-job file. No, the job
numbers will be different for each bookmark. Here is my current
code:

Sub FileSave()
'Created by Lisa Spencer on 12/27/2006
'FileSave Macro
'Call the SendPatientName procedure
SendPatientName
End Sub

Sub SendPatientName()
'declare variables
Dim oOutFile, oFSO
Dim oRange As Range

'create a file system object
Set oFSO = CreateObject("Scripting.FileSystemObject")
'create an output file named Bridge.txt
Set oOutFile = oFSO.OpenTextFile("C:\Winscribe\Files\Bridge.txt",
2, True)
i = 1
'j = 1
'loop through the tables and write all the patient names and job
numbers to the Bridge.txt file
For i = 1 To ActiveDocument.Tables.Count
'For j = 1 To ActiveDocument.Bookmarks.Count
Set oRange = ActiveDocument.Tables(i).Range
oRange.End = oRange.End - 2
oOutFile.Write oRange & ", "
InsertBookmark (JobNumbers)
oOutFile.Write ActiveDocument.Range.Bookmarks(i).Range.Text
oOutFile.WriteLine
Next
'Next

'close the file system object
oOutFile.Close
'show the save as dialog box
Dialogs(wdDialogFileSaveAs).Show
'save the file
ActiveDocument.SaveAs

'cleanup
Set oOutFile = Nothing
Set oFSO = Nothing

End Sub

Private Sub InsertBookmark(JobNumbers As String)

' Utility code used by the Insert macros below
If ActiveDocument.Bookmarks.Exists(JobNumbers) = True Then
ActiveDocument.Fields.Add Range:=Selection.Range, _
Type:=wdFieldRef, Text:=JobNumbers
Else
ActiveDocument.Bookmarks.Add Name:="JobNumbers", _
Range:=Selection.Range
End If

End Sub

This is the output in the text file(Patient Name followed by job
number):

Tim Hayes, 161
Logan Matthews, 162
Gracie Adams, 163
Laney Bossi, 164
Jacob Mayor, 166
Kent Armstorng, 167

Lisa

 

[Greg Maxey]

Lisa,

Perhaps I am being obtuse, but I still don't follow exactly what it is
that you are trying to achieve.

From your last post, I assume the you have an active document with

some number of tables. Based on your code, it appears that the only
information in those tables is a person's name. I assume this,
because your code write the table range to the output file and then
later on writes the Jobnumber. This tells me the only information in
the tabel the first round is the name:

Is this correct?

With your existing code, the bookmark is being added where the cursor
is each time because you are defining the bookmark range as the
selection range. If each bookmark has to go to a different location
then you have to change that location.

Let's assume that that location is Cell 1, 2 in the table. Somehthing
like this might work:

Option Explicit
Sub FileSave()
SendPatientName
End Sub
Sub SendPatientName()
Dim oOutFile, oFSO
Dim oRange As Range
Dim i As Long
Dim JobNumbers As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oOutFile = oFSO.OpenTextFile("C:\Test.txt", 2, True)
i = 1
For i = 1 To ActiveDocument.Tables.Count
Set oRange = ActiveDocument.Tables(i).Cell(1, 1).Range
oRange.End = oRange.End - 2
oOutFile.Write oRange & ", "
JobNumbers = "JobNumbers_" & i
InsertBookmark JobNumbers, ActiveDocument.Tables(i).Cell(1, 2).Range
oOutFile.Write ActiveDocument.Range.Bookmarks(i).Range.Text
oOutFile.WriteLine
Next
oOutFile.Close
Dialogs(wdDialogFileSaveAs).Show
ActiveDocument.SaveAs
Set oOutFile = Nothing
Set oFSO = Nothing
End Sub
Private Sub InsertBookmark(JobNumbers As String, oRng As Range)
If ActiveDocument.Bookmarks.Exists(JobNumbers) = True Then
ActiveDocument.Fields.Add Range:=oRng, _
Type:=wdFieldRef, Text:=JobNumbers
Else
ActiveDocument.Bookmarks.Add Name:=JobNumbers, _
Range:=oRng
End If
End Sub

If I am totally missing your intent, please try to clarify.

 

[Lisa]

Yes, you are correct. I used a table so I could loop through it. I
couldn't find a good way to loop through textboxes and also the table
cell won't show up like a text box when printed. I know I need to
change the range, but first I want to loop through the document and
see if there is a bookmark beside every DMIJOB#: and add it if there
is not. I need help with the code to see if there is a bookmark
there. Would I do that with a Range object? Thanks!

 

[Greg Maxey]

Ok. As you are already aware, you can't have two bookmarks with the
same name and you have to have a "name" and "range" to add a
bookmark. You can use the sequencing of "i" to change the bookmark
name for each new bookmark added.

Lets say the the record name is in Table(i).Cell(1,1) and the DMIJOB#
lable is in Table(i).Cell(1, 2). You want a bookmark placed adjacent
to each DIMJOB # label. How about using Table(i).Cell(1,3) like
this:

Sub FileSave()
SendPatientName
End Sub
Sub SendPatientName()
Dim oOutFile, oFSO
Dim oRange As Range
Dim i As Long
Dim JobNumbers As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oOutFile = oFSO.OpenTextFile("C:\Test.txt", 2, True)
i = 1
For i = 1 To ActiveDocument.Tables.Count
Set oRange = ActiveDocument.Tables(i).Cell(1, 1).Range
oRange.End = oRange.End - 2
oOutFile.Write oRange & ", "
JobNumbers = "JobNumbers_" & i
InsertBookmark JobNumbers, ActiveDocument.Tables(i).Cell(1, 3).Range
oOutFile.Write ActiveDocument.Range.Bookmarks(i).Range.Text
oOutFile.WriteLine
Next
oOutFile.Close
Dialogs(wdDialogFileSaveAs).Show
ActiveDocument.SaveAs
Set oOutFile = Nothing
Set oFSO = Nothing
End Sub
Private Sub InsertBookmark(JobNumbers As String, oRng As Range)
oRng.MoveEnd wdCharacter, -1
If Not oRng.Bookmarks.Exists(JobNumbers) Then
ActiveDocument.Bookmarks.Add Name:=JobNumbers, _
Range:=oRng
End If
End Sub

 

[Lisa]

I'm not using a table for the job number. I was just going to use a
bookmark. Is there anyway just to check to see if a bookmark exists
beside the text without using a table?

 

[Lisa]

For clarification, here is how one template is laid out:

PATIENT NAME: Kent Armstorng(1x1 table)
SOCIAL SECURITY #:
EMPLOYER:
DATE OF INJURY:
DATE OF SERVICE:
CLINIC LOCATION:

NEW INJURY EVALUATION

CHIEF COMPLAINT:

HISTORY OF PRESENT ILLNESS:

REVIEW OF SYSTEMS:

PAST MEDICAL HISTORY:

MEDICATIONS:

ALLERGIES:

SOCIAL HISTORY:

FAMILY HISTORY:

PHYSICAL EXAMINATION:
GENERAL:
VITALS:

ASSESSMENT:

DIAGNOSIS:

PLAN:

WORK STATUS:

CONDITION:


Electronically Approved

DICTATED BUT NOT READ

BB/dmi
DMIJOB#167(167 is within a bookmark)
D:
T:
<EOT>

 

[Greg Maxey]

Lisa,

Still not fully grasping exactly what it is that your are trying to do. You
have to have something to reference the range with. You can't (not easily
and maybe not at all) define the range as a spot next to some text that
comes after Table(i)

Why not use a table for our complete form? Name is Cell(1,1)
All the other stuff up to DMIJobNumber# is Cell(2,1)
DMIJobNumber# Cell(3,1) and the bookmark range is Cell(3,2)

 

[Lisa]

Greg,
That's the whole point of the bookmark. To reference the job number.
I need to check to see if each job number has a bookmark beside it so
I can reference it, then add one if it doesn't. I really don't care
to use another table cell if a bookmark will do the job.
Thanks,
Lisa

 

[Greg Maxey]

Lisa,

This string started out with you having several templates and you are going
to being inserting one or more templates into another template.

What are these "templates?" Is each identical to the sample text you
provided earlier? Where does the job number come from? Is it inputted by
the user? Is the number already in the "templates" as you add them to the
other template?
Is it put in afterwards.

I think I, or several others, that read these groups might be able to assist
you with an answer if you can provide a clear decription of the problem.

As it stands, I see a large document that consists of a bunch of single cell
tables that contain a name. Then a bunch of data fields. Finally a string
of text "DMIJobNumber#"

You want to know if there is a bookmark adjacent to that text if not you
want to add one at that piont.

Here is some rather crude code that does that:

Sub Test()
Dim oRng As Word.Range
Dim oBM As Word.Bookmark
Dim i As Long
Set oRng = ActiveDocument.Range
For i = 1 To ActiveDocument.Tables.Count
oRng.Start = ActiveDocument.Tables(i).Range.End
With oRng.Find
.Text = "DMIJobNumber#"
.Execute
If .Found = True Then
oRng.Collapse wdCollapseEnd
If oRng.Bookmarks.Count > 0 Then
MsgBox oRng.Bookmarks(1).Name
Else
oRng.Bookmarks.Add "Somename" & i, oRng
End If
End If
End With
Next i
End Sub

 

[Lisa]

Greg,
No, there are 7 different templates. The job number is entered by the
typist. No, the typist will enter the job number in each template as
the job is playing. The typist gets a dictated job, plays it, and
types the information in the template. She will then insert another
template, play another job, and type in the information. etc. for as
many times as she needs to until all the jobs are typed. With a
little tweeking, that worked. However, I need it to insert the
beginning and ending bookmarks with a space in between. For some
reason, Word won't read the job number correctly unless it's like this
DMIJOB#:[168]. I will try to figure this out on my own as I wait for
your reply. Thanks for your help!
Lisa

 

[Lisa]

If you assigned a bookmark to an item, the bookmark appears in
brackets ([...]) on the screen. If you assigned a bookmark to a
location, the bookmark appears as an I-beam. The brackets do not
print.

I need to assign the bookmark to an item.

 

[Greg Maxey]

If you assigned a bookmark to an item, the bookmark appears in
brackets ([...]) on the screen. If you assigned a bookmark to a
location, the bookmark appears as an I-beam. The brackets do not
print.

I need to assign the bookmark to an item.

Lisa,

With the code I provide last time the range where the bookmark is
inserted has been collapsed just after the #. I see that you have a
colon after the # (maybe I missed that before). To create a content
bookmark, you will need to move the end of the range out a certain
number of characters. These characters should probably be included in
your templates. Something like:

Sub Test()
Dim oRng As Word.Range
Dim oBM As Word.Bookmark
Dim i As Long
Set oRng = ActiveDocument.Range
For i = 1 To ActiveDocument.Tables.Count
oRng.Start = ActiveDocument.Tables(i).Range.End
With oRng.Find
.Text = "DMIJobNumber#:"
.Execute
If .Found = True Then
oRng.Collapse wdCollapseEnd
oRng.MoveEnd wdCharacter, 4
If oRng.Bookmarks.Count > 0 Then
MsgBox oRng.Bookmarks(1).Name
Else
oRng.Bookmarks.Add "Somename" & i, oRng
End If
End If
End With
Next i
End Sub

 

[Lisa]

That got it Greg! Thanks so much for your help! Lisa

 

[Greg Maxey]

That got it Greg! Thanks so much for your help! Lisa

Lisa,

Glad to help.

 

[Helmut Weber]

Hi Submariner,

excellent job,

maybe have a look at above
"Code to find text in a column of a table".

Just another clueless user, like all of us once were.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Greg Maxey]

Nice job yourself. Thanks.