Updating a Table from a Calendar Form

[Forgeman]

I've creating an Access project, which is at an early stage. I'm using Access 2003 with a default file format set to Access 2000.

I've been trying to update a date field within a table using this piece of code from a Calendar form. The Calendar form has a Command Button called cmd_Accept. Its sub routine is shown below. Both variables, dt (date) and fvr_id (field visit report ID) are global.

The code works - too well! Instead of updating the only the target record, it will either update the first record plus the target record or all records with the same date and I cannot understand why this should happen.

[Field Visit Report ID] is unique, being the primary key for the table, tbl_field_visit. It is AutoNumber generated. I've double-checked the table and all entries in [Field Visit Report ID] are unique. All my MsgBOX displays show what I would expect to see.

As you can see, I've also tried doing the same task using SQL - with exactly the same result.

I've been going round and round with this for days. Should I bin this and go down another route, or can anyone tell me where I'm going wrong?

Any help much appreciated.



Private Sub cmd_Accept_Click()

Dim dbs As Database, rst As Recordset
Dim strSQL As String

dt = ocxCalendar.Value
' +++++++++++++++++++++
' Field Visit Report ID now set from another sub routine. Tested and working.
' fvr_id = Form.[Field Visit Report ID]
' +++++++++++++++++++++
' MsgBox "The Field visit report ID is " & fvr_id, vbOKOnly
' MsgBox "The date is " & dt, vbOKOnly

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tbl_field_visit")
If rst.RecordCount <> 0 Then rst.MoveFirst

MsgBox "fvr_id = " & fvr_id & " Date = " & dt, vbOKOnly
Do While Not rst.EOF
If (rst![Field Visit Report ID] = fvr_id) Then
MsgBox "The Record ID is " & fvr_id, vbOKOnly
found = True
With rst
.Edit
!Date = dt
.Update
.Bookmark = .LastModified
End With
End If
rst.MoveNext
Loop
rst.Close

' If found Then
' vbButtons = vbOKOnly + vbExclamation
' MsgBox "Record Found! " & " Date = " & dt & " Field Visit Report ID = " & fvr_id, vbButtons
' If rst.RecordCount <> 0 Then rst.MoveFirst
' strSQL = "SELECT tbl_Field_Visit.Date FROM tbl_Field_Visit WHERE tbl_Field_Visit.[Field Visit Report ID] = " & fvr_id
' Me.RecordSource = strSQL
' MsgBox strSQL, vbOKOnly
' strSQL = "INSERT INTO tbl_Books ([Date], VALUES '" & dt & "')"
' strSQL = "UPDATE tbl_Field_Visit SET tbl_Field_Visit.Date = '" & dt & "' WHERE tbl_Field_Visit.[Field Visit Report ID] = " & fvr_id
' MsgBox "strSQL = " & strSQL, vbOKOnly
' dbs.Execute strSQL
' End If

dbs.Close

Set rst = Nothing
Set dbs = Nothing

fvr_id = 0
DoCmd.Close

End Sub

 

[Forgeman]

Have now scrapped this code and reworked a solution (which works!).