It's 2003. I thought so as well and in both cases you listed it does not. I
tried both a msgbox and traping in the debugger. Nethier seem to fire. I
can complete the entire record and tab to the next without the event firing,
however the beforeupdate will fire.
Strange.
Here is the src incase it helps.
Option Compare Database
Option Explicit
Private Function CalcTax() As Boolean
Dim dbLoc As DAO.Database, rsLoc As DAO.Recordset
Dim sSQL As String, lTax As Single
On Error GoTo err_CalcTax
If (IsNull(Me.Location)) Then
CalcTax = False
Exit Function
End If
If (Not Me.Taxable) Then
Me.txtTaxAmount = 0
CalcTax = True
Exit Function
End If
Set dbLoc = CurrentDb()
sSQL = "SELECT * FROM tblLocations WHERE PS_LOC='" _
& Me.Location & "';"
Set rsLoc = dbLoc.OpenRecordset(sSQL, dbOpenDynaset)
rsLoc.MoveLast
If (Not (rsLoc.BOF And rsLoc.EOF)) Then
lTax = rsLoc.Fields("Tax")
Me.txtTaxAmount = (Me.Extended * lTax)
CalcTax = True
End If
exit_CalcTax:
rsLoc.Close
dbLoc.Close
Set rsLoc = Nothing
Set dbLoc = Nothing
Exit Function
err_CalcTax:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In CalcTax", vbExclamation + vbOKOnly, Me.Name
Resume exit_CalcTax
End Function
Private Sub Form_AfterUpdate()
UpdateMiscFields
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim vResult As Variant
If (Me.Qty = 0) Then
vResult = MsgBox("You have a QTY of 0 on line# " & Me.LineNbr & _
", Do you want to continue with a 0 Qty?", vbExclamation +
vbYesNo, "Qty Error")
If (vResult = vbNo) Then Cancel = True
Else
'vResult = UpdateMiscFields
Cancel = False
End If
End Sub
Private Sub Form_Open(Cancel As Integer)
On Error GoTo err_Form_Open
If (Not IsLoaded("frmMaintainPO")) Then
Cancel = True
Else
If (Me.Parent.Name <> "frmMaintainPO") Then Cancel = True
End If
If (Cancel) Then
MsgBox "For use from the frmMaintainPO Form only", _
vbOKOnly
Cancel = True
End If
exit_Form_Open:
Exit Sub
err_Form_Open:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Form_Open", vbExclamation + vbOKOnly, Me.Name
Resume exit_Form_Open
End Sub
Private Sub Location_AfterUpdate()
Dim vResult As Variant
On Error GoTo err_Location_AfterUpdate
If ((Me.Qty > 0) And (Me.Cost > 0)) Then
vResult = CalcTax
End If
Me.PartNum.SetFocus
exit_Location_AfterUpdate:
Exit Sub
err_Location_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Location_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_Location_AfterUpdate
End Sub
Private Sub Location_BeforeUpdate(Cancel As Integer)
Dim vResult As Variant
If (Me.Location <> Me.Parent.Controls("ShipTo")) Then
vResult = MsgBox("The location is different than the ShipTo
specified on the Header." & vbCrLf & _
vbCrLf & "The location on the Lines is only used for accounting
purposes and will" & vbCrLf & _
"will not affect the shipment." & vbCrLf & vbCrLf, vbInformation
+ vbOKOnly, "Notice")
'
End If
End Sub
Private Sub PartNum_AfterUpdate()
On Error GoTo err_PartNum_AfterUpdate
Me.Cost.SetFocus
exit_PartNum_AfterUpdate:
Exit Sub
err_PartNum_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In PartNum_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_PartNum_AfterUpdate
End Sub
Private Sub PartNum_BeforeUpdate(Cancel As Integer)
Dim vResult As Variant, LineNumber As Integer
'On Error GoTo err_PartNum_BeforeUpdate
bAbortItemAdd = False
If (Not GetPart) Then
vResult = MsgBox("Item """ & Me.PartNum & """ was not found!" _
& vbCrLf & "Do you want to add this item?", vbInformation +
vbYesNoCancel, _
"Not Found")
If (vResult = vbYes) Then
Do While (Not bAbortItemAdd)
DoCmd.OpenForm "frmMaintainItems", , , , acFormAdd,
acDialog, Me.PartNum
'DoCmd.OpenForm "frmMaintainItems", , , , acFormAdd, ,
Me.PartNum
If (Not bAbortItemAdd) Then
GetPart
Cancel = False
Else
Me.Undo
Cancel = True
End If
Loop
bAbortItemAdd = False ' reset var
Else
Cancel = True
End If
Else
If (Not VerifyVendor) Then
vResult = MsgBox("The item you entered '" & Me.PartNum & _
"' is in the item file under a different vendor." & _
vbCrLf & vbCrLf & "Do you want to keep this item on the
PO?", _
vbExclamation + vbYesNo, "Vendor Conflict")
If (vResult = vbNo) Then
Me.Undo
Cancel = True
End If
End If
If ((Me.Qty > 0) And (Me.Cost > 0)) Then
vResult = CalcTax
End If
End If
If (Cancel = False) Then
' Update the Line Number
Me.LineNbr.Value = NextLineNbr(Me.POnum.Value)
End If
exit_PartNum_BeforeUpdate:
Exit Sub
err_PartNum_BeforeUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In PartNum_BeforeUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_PartNum_BeforeUpdate
End Sub
Function NextLineNbr(sPOnum As String) As Integer
Dim dbPO As DAO.Database, rsPO As DAO.Recordset
Dim sSQL As String
On Error GoTo err_NextLineNbr
Set dbPO = CurrentDb()
sSQL = "SELECT Max(tblPODetail.LineNbr) AS LastLineNbr " & _
"FROM tblPODetail " & _
"WHERE (((tblPODetail.PONum)='" & sPOnum & "'));"
Set rsPO = dbPO.OpenRecordset(sSQL, dbOpenDynaset)
If (IsNull(rsPO!LastLineNbr)) Then
NextLineNbr = 1
Else
NextLineNbr = (rsPO!LastLineNbr + 1)
End If
exit_NextLineNbr:
rsPO.Close
dbPO.Close
Set rsPO = Nothing
Set dbPO = Nothing
Exit Function
err_NextLineNbr:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In NextLineNbr", vbExclamation + vbOKOnly, Me.Name
Resume exit_NextLineNbr
End Function
Function VerifyVendor() As Boolean
Dim dbItem As DAO.Database, rsItem As DAO.Recordset
Dim sSQL As String, sVendor As String
On Error GoTo err_VerifyVendor
VerifyVendor = False
Set dbItem = CurrentDb()
sSQL = "SELECT * FROM tblItemFile WHERE PartNum='" & Me.PartNum & "';"
Set rsItem = dbItem.OpenRecordset(sSQL, dbOpenDynaset)
If ((Not (rsItem.BOF And rsItem.EOF)) And (rsItem.RecordCount > 0)) Then
rsItem.MoveLast
rsItem.MoveFirst
sVendor = Forms!frmMaintainPO.VendorID
If (sVendor = rsItem.Fields("VendorID")) Then
VerifyVendor = True
End If
End If
exit_VerifyVendor:
rsItem.Close
dbItem.Close
Set rsItem = Nothing
Set dbItem = Nothing
Exit Function
err_VerifyVendor:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In VerifyVendor", vbExclamation + vbOKOnly, Me.Name
Resume exit_VerifyVendor
End Function
Function GetPart() As Boolean
Dim dbItem As DAO.Database, rsItem As DAO.Recordset
Dim sSQL As String
On Error GoTo err_GetPart
Set dbItem = CurrentDb()
sSQL = "SELECT * FROM tblItemFile WHERE PartNum='" _
& Me.PartNum & "';"
Set rsItem = dbItem.OpenRecordset(sSQL, dbOpenDynaset)
If (Not (rsItem.BOF And rsItem.EOF)) Then
Me.Description = rsItem.Fields("Description")
Me.Cost = rsItem.Fields("Cost")
Me.Taxable = rsItem.Fields("Taxable")
GetPart = True
Else
GetPart = False
End If
exit_GetPart:
rsItem.Close
dbItem.Close
Set rsItem = Nothing
Set dbItem = Nothing
Exit Function
err_GetPart:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In GetPart", vbExclamation + vbOKOnly, Me.Name
Resume exit_GetPart
End Function
Private Sub Qty_AfterUpdate()
Dim vResult As Variant
On Error GoTo err_Qty_AfterUpdate
If (Me.Qty > 0 And Me.Cost > 0) Then
Me.Extended = (Me.Qty * Me.Cost)
Else
Me.Extended = 0
End If
If (IsNull(Me.Qty) Or IsNull(Me.Cost)) Then
Me.Extended = 0
End If
If ((Me.Extended.OldValue <> Me.Extended.Value) Or
(IsNull(Me.Extended.OldValue))) Then
If (CalcTax = False) Then
MsgBox "Error calculating the tax. Please verify your entry", _
vbExclamation + vbOKOnly, "Tax Error"
End If
End If
exit_Qty_AfterUpdate:
Exit Sub
err_Qty_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Qty_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_Qty_AfterUpdate
End Sub
Private Sub Taxable_AfterUpdate()
Dim vResult As Variant
If ((Me.Qty > 0) And (Me.Cost > 0)) Then
vResult = CalcTax
End If
On Error GoTo err_Taxable_AfterUpdate
exit_Taxable_AfterUpdate:
Exit Sub
err_Taxable_AfterUpdate:
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf
& _
"In Taxable_AfterUpdate", vbExclamation + vbOKOnly, Me.Name
Resume exit_Taxable_AfterUpdate
End Sub
Private Function UpdateMiscFields() As Boolean
' If (Me.NewRecord) Then
' Me!Received = False
' Else
Application.Forms(Me.Parent.Name).UpdatePOFooter
If (Err.Number <> 0) Then
UpdateMiscFields = True
Else
UpdateMiscFields = False
End If
' End If
End Function
What version of Access? The SubForm's AfterUpdate event should fire when the
SubForm is Dirty and you move the focus back to the MainForm.
[quoted text clipped - 7 lines]