Merging Bookmarks

[A_Classic_Man]

I have a Word 97 form with bookmarks. I have a command button with
code that sends the bookmarked data to an Access database. I want to
include in the code a way to check Bookmark A. If Bookmark A contains
no data, insert the data from Bookmarks B and C into Bookmark A.

Thanks for any help you can give me

Ron

 

[David Sisson]

Try this
Sub CombineBM()

Dim Adoc As Document
Dim BMRng As Range

Set Adoc = ActiveDocument

Set BMRng = Adoc.Bookmarks("BM1").Range

If Len(BMRng.Text) = 0 Then
BMRng = Adoc.Bookmarks("BM2") & Adoc.Bookmarks("BM3")
Adoc.Bookmarks.Add "BM1", BMRng 'Encloses text with BM1
End If

End Sub

You can probably combine the two bookmarks at the point where it's
written to Access. Show us the code at that point for further
suggestions.

 

[A_Classic_Man]

Try this
Sub CombineBM()

Dim Adoc As Document
Dim BMRng As Range

Set Adoc = ActiveDocument

Set BMRng = Adoc.Bookmarks("BM1").Range

If Len(BMRng.Text) = 0 Then
    BMRng = Adoc.Bookmarks("BM2") & Adoc.Bookmarks("BM3")
    Adoc.Bookmarks.Add "BM1", BMRng 'Encloses text with BM1
End If

End Sub

You can probably combine the two bookmarks at the point where it's
written to Access.  Show us the code at that point for further
suggestions.

I should have mentioned the bookmarks are in a protected document.
The command button is password protected.

Thanks for the help

Ron

Here is the code:

Private Sub cmdSendFieldInitiated_Click()

Dim DocName As String
Dim LinkCriteria As String
Dim AuthCode As String
Dim Response As String
Dim Response2 As String

Response = MsgBox("Enter Password", vbOKCancel, "Authorization
Needed")

If Response = vbOK Then
AuthCode = InputBox("Enter Password", "Password")

If AuthCode = "Password" Then
GoTo Line1
Else
Response2 = MsgBox("That is not a valid authorization code.",
vbOKOnly, "Invalid Authorization Code")
End If
Exit_cmdSendToDataBase_Click:
Exit Sub
Err_cmdSendToDataBase_Click:
MsgBox Err.Description
Resume Exit_cmdSendToDataBase_Click

Line1:
Dim strfldEventNum As Long '(Bookmark1)
Dim strfldEventDate As Date
Dim strfldReqDate As Date
Dim strfldApp1 As String '(Bookmark2)
Dim strfldApp1Shift As String '(Bookmark3)

Set ThisDoc = ActiveDocument

fldEventNum = ThisDoc.FormFields("fldEventNum").Result
fldApp1 = ThisDoc.FormFields("fldApp1").Result
fldApp1Shift = ThisDoc.FormFields("fldApp1Shift").Result

Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)
Set MyDb = wrkJet.OpenDatabase("I:\OFDPubEd\OFD_214")
Set MyTbl = MyDb.OpenRecordset("OFD214FieldInitiated")

With MyTbl
.AddNew

If fldEventNum <> "" Then
!EventNum = fldEventNum
End If

!App1 = fldApp1

If fldApp1Shift <> "" Then
!App1Shift = fldApp1Shift
End If

.Update
End With

Set MyTbl = Nothing
Set MyDb = Nothing
Set wrkJet = Nothing

End Sub

 

[David Sisson]

These DIMS's don't refer to anything in the code shown.
Probably should not have the 'str' in front of each variable.

    Dim strfldEventNum As Long '(Bookmark1)
    Dim strfldEventDate As Date
    Dim strfldReqDate As Date
    Dim strfldApp1 As String '(Bookmark2)
    Dim strfldApp1Shift As String  '(Bookmark3)

    Set ThisDoc = ActiveDocument

      fldEventNum = ThisDoc.FormFields("fldEventNum").Result
      fldApp1 = ThisDoc.FormFields("fldApp1").Result
      fldApp1Shift = ThisDoc.FormFields("fldApp1Shift").Result

IF len(fldEventNum) = 0 then
fldEventNum = fldApp1 & fldApp1Shift
end if

 

[A_Classic_Man]

These DIMS's don't refer to anything in the code shown.
Probably should not have the 'str' in front of each variable.




IF len(fldEventNum) = 0 then
   fldEventNum = fldApp1 & fldApp1Shift
end if






- Show quoted text -

Thanks for the help, works great.
Ron