I know there have been many threads regarding this error but I have narrowed down the culprit but do not know what needs to be fixed. This only happens to one of my forms in tab control but it is complicated.
History...
Tab control main form (frm_home)
Form on a tab having issues (frm_labtestinput) with 3 subforms (frm_usbinput, frm_usbinput2, and frm_usbinput3) with showstretch
The code for frm_labtestinput
This code represents what is on each of the 3 subforms... pretty much the same:
When a record is present on frm_labtestinput that does not require one of the subforms to appear... no errors when I click the submit button (UpdateRecord_Click)
When a record is present that requires one of the subforms to show... if you skip editing any data in the subform and click the submit button (UpdateRecord_Click)... no errors... no issues... but if you edit anything in one of the subforms and click the submit button I get error 3197... but... if I tab from the last control on the subform to the submit button (UpdateRecord_Click)... no error.
I have tested this every which way I can and it comes down to something in the code that is missing.
Can anyone see what is missing in the code to cause this? It used to work but now I have to use On Error Resume Next to stop the error popup but it requires the form be submitted twice to update the record.
History...
Tab control main form (frm_home)
Form on a tab having issues (frm_labtestinput) with 3 subforms (frm_usbinput, frm_usbinput2, and frm_usbinput3) with showstretch
The code for frm_labtestinput
Code:
Option Compare Database
Option Explicit
Private blnGood As Boolean
Private Sub cmdLabQuestion_Click()
DoCmd.OpenForm "frm_newlabrecordhowto", , , , , acDialog
End Sub
Private Sub cmdNewLabRecord_Click()
DoCmd.OpenForm "frm_newlabrecord", , , , , acDialog
End Sub
Private Sub cmdLabAttachments_Click()
DoCmd.OpenForm "frm_labattachments", , , , , acDialog
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim HasUSB As Long
HasUSB = DLookup("HasUSB", "tbl_parts", "ID = " & Me.Part_Number)
If HasUSB = 2 Then
ShowStretch
ElseIf HasUSB = 1 Then
ShowStretch2
ElseIf HasUSB = 11 Then
ShowStretch3
Else
HideShrink
End If
End Sub
Private Sub ShowStretch()
Me.InsideHeight = 10000
Me.UsbInput1.Visible = True
Me.USBInput2.Visible = False
Me.USBInput3.Visible = False
Me.UsbInput1.Height = 7600
Me.UpdateRecord.Top = 9500
End Sub
Private Sub ShowStretch2()
Me.InsideHeight = 3000
Me.UsbInput1.Visible = False
Me.USBInput2.Visible = True
Me.USBInput3.Visible = False
Me.USBInput2.Height = 4700
Me.UpdateRecord.Top = 6460
End Sub
Private Sub ShowStretch3()
Me.InsideHeight = 10000
Me.UsbInput1.Visible = False
Me.USBInput2.Visible = False
Me.USBInput3.Visible = True
Me.USBInput3.Height = 7600
Me.UpdateRecord.Top = 9500
End Sub
Private Sub HideShrink()
Me.InsideHeight = 7560
Me.UsbInput1.Visible = False
Me.USBInput2.Visible = False
Me.USBInput3.Visible = False
Me.UsbInput1.Height = 0
Me.USBInput2.Height = 0
Me.UpdateRecord.Top = 1800
End Sub
Private Sub cboGoToRecord_AfterUpdate()
On Error Resume Next
Dim rst As Object
Dim HasUSB As Long
Set rst = Me.RecordsetClone
rst.FindFirst "AuditID = " & Me.cboGoToRecord.Value
Me.Bookmark = rst.Bookmark
HasUSB = DLookup("HasUSB", "tbl_parts", "ID = " & Me.Part_Number)
If HasUSB = 2 Then
ShowStretch
ElseIf HasUSB = 1 Then
ShowStretch2
ElseIf HasUSB = 11 Then
ShowStretch3
Else
HideShrink
End If
End Sub
Private Sub Form_Current()
Me.cboGoToRecord.Value = Me.AuditID.Value
End Sub
Private Sub UpdateRecord_Click()
Dim strMsg As String
On Error Resume Next
blnGood = True
If (validate) Then
Me.Recordset.Edit
Me.Recordset.Fields("status").Value = "Complete"
Me.Recordset.Fields("LabInspectorUserID").Value = Credentials.UserId
Me.Recordset.Fields("LabUpdate").Value = Date
Me.Recordset.Update
If Me.CurrentRecord < Me.Recordset.RecordCount Then
Me.Recordset.MoveNext
Else
Me.Recordset.MoveFirst
End If
Else
strMsg = "All Fields are required."
Call MsgBox(Prompt:=strMsg, Title:="Before Update")
End If
Application.Echo False
DoCmd.Close
DoCmd.OpenForm "frm_home"
Form_frm_home.Lab_Test_Input_Form.SetFocus
Application.Echo True
blnGood = False
End Sub
Private Function validate() As Boolean
validate = True
If (IsNull(Me.LabTestDate.Value)) Then
validate = False
End If
If (IsNull(Me.TotalFunctBad.Value)) Then
validate = False
End If
If (IsNull(Me.TotalFunctTested.Value)) Then
validate = False
End If
If (IsNull(Me.TotalFunctGood.Value)) Then
validate = False
End If
If (Credentials.UserId = 0 Or IsNull(Credentials.UserId)) Then
validate = False
End If
End Function
This code represents what is on each of the 3 subforms... pretty much the same:
Code:
Option Compare Database
Option Explicit
Private blnGood As Boolean
Private Sub Part55MinReading1_2_KeyDown(KeyCode As Integer, Shift As Integer)
If (KeyCode = vbKeyTab And Shift = 0) Then
KeyCode = 0
Me.InitReading1.SetFocus
Me.Parent!UpdateRecord.SetFocus
End If
End Sub
When a record is present on frm_labtestinput that does not require one of the subforms to appear... no errors when I click the submit button (UpdateRecord_Click)
When a record is present that requires one of the subforms to show... if you skip editing any data in the subform and click the submit button (UpdateRecord_Click)... no errors... no issues... but if you edit anything in one of the subforms and click the submit button I get error 3197... but... if I tab from the last control on the subform to the submit button (UpdateRecord_Click)... no error.
I have tested this every which way I can and it comes down to something in the code that is missing.
Can anyone see what is missing in the code to cause this? It used to work but now I have to use On Error Resume Next to stop the error popup but it requires the form be submitted twice to update the record.