Looking at the code, it appears to me that the form's Current event
always dirties the current record, so that means that the BeforeUpdate
and AfterUpdate events should always fire. That may not be what you
really want, but if I'm not mistaken that's what *should* happen.
Now, you tell me two things: (1) the Form_BeforeUpdate() event
procedure seems to be firing while the Form_AfterUpdate() procedure is
not, and (2) the form doesn't seem to move on to the next record. As
for item (1), the first thing you should check, if you haven't already,
is that the form's AfterUpdate event *property* (on the Event tab of the
form's property sheet), is set to "[Event Procedure]". If for some
reason that property has been cleared, the event procedure won't be
called.
For item (2), well, I'm a bit perplexed. But I notice that you are
setting the focus all over the place in the BeforeUpdate event . Maybe
that's somehow keeping Access from moving the form on to the next
record. But you almost certainly don't need to be doing this. It looks
to me like you think you need to set the focus to a control to get or
set its value -- you're using SetFocuse and then interrogating the
control's Text property. That is not the best way to do it. If you use
the control's Value property, which is its default property, the control
doesn't have to have the focus. So I suggest changing your code to use
the controls' Value property, and remove all the unnecessary SetFocus
calls. That may or may not solve the problem you're having, but at
least it will eliminate that as a possible source of error.
Note that, if you are testing a control's Value property to see if the
control is blank or empty, you must usually check whether the value is
Null, as well as whether the value is a zero-length string (""). But
you can't actually test to see if a control is equal to Null, because
Null is not equal to anything, even itself. So the most comprehensive
way to cover both possibilities -- Null, or zero-length string -- is
like this:
If Len(Me!SomeControl & vbNullString) = 0 Then
' the control is blank or empty
Else
' it isn't
End If
Try these suggestions and get back to me. Or maybe someone else will
spot the problem in the mean time.
--
Dirk Goldgar, MS Access MVP
www.datagnostics.com
(please reply to the newsgroup)
Gerry said:
It appears the new records only got added when I was in some odd state
between cancelling debugging and the process. The Form BeforeUpdate
event kicks off every time I press any arrow on record selector but
no AfterUpdate event is fired, even though all the edits are passed.
Here's the code - thanks.
********************************************
Option Compare Database
Public gPeople, gRate, gRoom As Boolean
Private Sub Additional_With_Meals_Change()
Calc_Rates_for_Room
End Sub
Private Sub cmbRate_AfterUpdate()
' MsgBox "cmbRate_AfterUpdate()"
gRate = True
Calc_Rates_for_Room
Fill_Rate_Description
Set_Additional_meals
End Sub
Private Sub Set_Additional_meals()
If cmbRate.Text = "O" Or cmbRate.Text = "I" Then
Me.Additional_With_Meals.Enabled = False
Else
Me.Additional_With_Meals.Enabled = True
End If
End Sub
Private Sub Fill_Rate_Description()
Dim strSQL As String
Dim strDesc As String
Dim bGot_Rate As Boolean
Me.cmbRate.SetFocus
Me.lblRateDesc.Caption = ""
'query rate table
strSQL = "SELECT Rate_cd.RATE_DESC FROM Rate_cd WHERE
(((Rate_cd.RATE_CODE)="
strSQL = strSQL & Chr(34) & Me.cmbRate.Text & Chr(34) & "));"
bGot_Rate = Read_Rate_CD(strSQL)
If bGot_Rate = False Then 'check obsolete rate file
strSQL = "SELECT Obsolete_rates.RATE_DESC FROM Obsolete_rates
WHERE (((Obsolete_rates.RATE_CODE)="
strSQL = strSQL & Chr(34) & Me.cmbRate.Text & Chr(34) & "));"
bGot_Rate = Read_Rate_CD(strSQL)
If bGot_Rate = True Then
Me.lblRateDesc.Caption = Me.lblRateDesc.Caption & " -
obsolete" End If
End If
End Sub
Private Function Read_Rate_CD(strSQL As String) As Boolean
On Error GoTo Read_Rate_CD_Error
Dim dbs As Database
Dim rstTemp As Recordset
Dim strRateDesc As String
Set dbs = CurrentDb
Set rstTemp = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
' OpenRecordsetOutput rstTemp
With rstTemp
.MoveFirst
Me.lblRateDesc.Caption = .Fields!RATE_DESC
.Close
End With
Read_Rate_CD = True 'strRateDesc
Exit Function
Read_Rate_CD_Error:
Read_Rate_CD = False
End Function
Private Sub Fill_Room_Info()
On Error GoTo Fill_Room_Info_Error
Dim dbs As Database
Dim rstTemp As Recordset
Dim strSQL As String
Set dbs = CurrentDb
Me.cmbRoom.SetFocus
strSQL = "SELECT Room_tab.ROOM_NBR, Room_typ.ROOM_DESC,
room_tab.ROOM_LOC "
strSQL = strSQL & "FROM Room_tab INNER JOIN Room_typ ON
Room_tab.ROOM_TYPE = Room_typ.ROOM_TYPE"
strSQL = strSQL & " Where Room_tab.ROOM_NBR = " & cmbRoom.Text
strSQL = strSQL & " ORDER BY Room_tab.ROOM_NBR;"
'Debug.Print strSQL
Set rstTemp = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
With rstTemp
.MoveFirst
Me.lblRoomDesc.Caption = .Fields!ROOM_DESC
'Me.RM_LOC1.SetFocus
Me.RM_LOC1 = .Fields!ROOM_LOC
Me.cmbRoom.SetFocus
.Close
End With
Exit Sub
Fill_Room_Info_Error:
MsgBox ("Error in Fill_Room_Info : " & Err.Number & " -- " &
Err.Description)
Resume
End Sub
Private Sub cmbRoom_AfterUpdate()
MsgBox "cmbRoom_AfterUpdate()"
gRoom = True
Calc_Rates_for_Room
cmbRate.SetFocus
If cmbRate.Text <> "" Then
Fill_Room_Info
End If
End Sub
Private Sub Calc_Check_Out_Date()
With Me.CHECK_OUT
.Enabled = True
.SetFocus
.Locked = False
' .Text = Format(Me.FINAL_NITE + 1, "short date")
.Text = Format(Me.DTLast_Night + 1, "short date")
' Me.NO_OF_DAYS = DateDiff("d", Me.ARR_DATE, Me.FINAL_NITE +
1) Me.NO_OF_DAYS = DateDiff("d", Me.DTArrive_Date,
Me.DTLast_Night + 1) Me.cmbRate.SetFocus
.Enabled = False
.Locked = True
End With
Calc_Rates_for_Room
End Sub
Private Sub DTArrive_Date_Change()
Calc_Check_Out_Date
End Sub
Private Sub DTLast_Night_Change()
Calc_Check_Out_Date
End Sub
Private Sub Form_AfterUpdate()
'used to tell whe the rates can be calc's
'set on exit from corresponding controls
MsgBox "Form_AfterUpdate()"
gRoom = False
gRate = False
gPeople = False
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
MsgBox "Form_BeforeUpdate()" 'debug
' ensure all required fields were entered
' tag = "New" denotes a new record is in progress
Dim x As Integer
If Me.Tag = "New" Then
For Each ctl In Me 'frm.Controls
If ctl.ControlType = acTextBox And ctl.Name <>
"Special_Instruction" _
Or ctl.ControlType = acComboBox Then
If ctl.Enabled = True Then
ctl.SetFocus
Debug.Print ctl.Name & " = " & ctl.Text
If ctl.Text = "" Then
x = MsgBox("Cannot proceed " & ctl.Name & "
required field are empty", , "Confirmations")
' Cancel = True 'should this be activated?
ctl.Undo
Exit For
End If
End If
End If
Next
End If
End Sub
Private Sub Form_Click()
MsgBox "Form Clicked"
End Sub
Private Sub Form_Current()
Dim intNewRec As Integer
' clear unbound files
Me.lblRateDesc.Caption = ""
Me.lblRoomDesc.Caption = ""
intNewRec = Me.NewRecord
Me.FIRST_NAME.SetFocus
If intNewRec = True Then
Me.Tag = "New"
Me.CONF_DATE = Format(Now, "short date")
Else
Me.Tag = ""
Fill_Rate_Description
Fill_Room_Info '(False)
Me.FIRST_NAME.SetFocus
cmbRate.SetFocus
Set_Additional_meals 'sub
Me.FIRST_NAME.SetFocus
End If
End Sub
Private Sub RATE_ADJ_AfterUpdate()
Calc_Charges
End Sub
Private Sub Calc_Charges()
Me.RATE_ADJ = IIf(Me.RATE_ADJ <> Null, Me.RATE_ADJ, 0)
Me.TOT_D_RATE = Me.DAILY_RATE + Me.AP_CHARGE + Me.RATE_ADJ
Me.TOT_CHARGE = Me.TOT_D_RATE * 2 'Me.NO_OF_DAYS
Me.TAX = Me.TOT_CHARGE * 0.097
Me.SUBTOTAL = Me.TOT_CHARGE + TAX
Me.DEPOSIT = IIf(Me.DEPOSIT <> Null, Me.DEPOSIT, 0)
Me.BALANCE = Me.SUBTOTAL - Me.DEPOSIT
End Sub
Public Sub Calc_Rates_for_Room()
On Error GoTo Calc_Rates_for_Room_Error
' get rates for the room, then calc total rate amounts
Dim dbs As Database
Dim rstTemp As Recordset
Dim strRateDesc As String
Set dbs = CurrentDb
'can only run qry when all 3 values are there,
' tried setfocus and check the control value but new rec had
problem If Me.Tag = "New" Then
If gRoom = False _
Or gRate = False _
Or gPeople = False Then
Exit Sub
End If
End If
'if new record and the dates were defaulted they go to today
' so the number of days is 2
Me.NO_OF_DAYS = IIf(Me.NO_OF_DAYS <> Null, Me.NO_OF_DAYS, 2)
strSQL = "SELECT Room_tab.ROOM_NBR, Rate_tab.PP_RATE,
Rate_tab.AP_CHARGE, Rate_tab.MEAL_CHARG "
strSQL = strSQL & "FROM (Rate_tab INNER JOIN Room_tab ON
Rate_tab.ROOM_TYPE = Room_tab.ROOM_TYPE) "
strSQL = strSQL & "INNER JOIN Room_typ ON Room_tab.ROOM_TYPE =
Room_typ.ROOM_TYPE "
Me.cmbRoom.SetFocus
strSQL = strSQL & "WHERE (((Room_tab.ROOM_NBR)= " & cmbRoom.Text
Me.cmbRate.SetFocus
strSQL = strSQL & ") AND ((Rate_tab.RATE_CODE)=" & Chr(34) &
cmbRate.Text & Chr(34) & "));"
Set rstTemp = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
With Me.Additional_With_Meals
If .Enabled = True Then .SetFocus
If .Value <> Null Then 'doesn't work if = null???
Else
.Value = 0
End If
End With
With rstTemp
.MoveFirst
Me.DAILY_RATE = .Fields!PP_RATE
Me.AP_CHARGE = .Fields!AP_CHARGE * (Me.Tot_People - 2) + _
(Me.Additional_With_Meals *
(.Fields!MEAL_CHARG / Me.NO_OF_DAYS))
.Close
End With
Calc_Charges
Exit Sub
Calc_Rates_for_Room_Error:
MsgBox ("Error in Read_Rate_CD : " & Err.Number & " -- " &
Err.Description)
Resume 'Next
End Sub
Private Sub Tot_People_AfterUpdate()
' MsgBox "Tot_People_AfterUpdate()"
gPeople = True ' total people entered
Calc_Rates_for_Room
End Sub
********************************************
