R
Robert Nusz @ DPS
My subform fails to add new records and I'm lost.
Parent form updates primary table, subform of parent form updates/views
secondary table linked to primary via parent/child primary key links.
I need to be able to add records to secondary table (DB2 table), I have
rights to add, update, delete, change, records in db2, so that is not the
issue. It's my code that fails, to new to VB code procedures. Can someone
assist please.
On add records button, I want to clear active screen, allow data entry of
new record and pass this record to secondary table appending this record to
end of existing table. Any clues.
This is the code:
Option Compare Database
Private Sub Command33_Undo_Changes_Click()
On Error GoTo Err_Command33_Undo_Changes_Click
DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
Exit_Command33_Undo_Changes_Click:
Exit Sub
Err_Command33_Undo_Changes_Click:
MsgBox Err.Description
Resume Exit_Command33_Undo_Changes_Click
End Sub
Private Sub Command63_Return_Main_Page_Click()
Me.Parent.SetFocus
End Sub
Private Sub Form_AfterUpdate()
Me.Refresh
Me.CASE_NUM_YR_OTHER = Me.unbtxt_PREV_CASE_YR
Me.CASE_NUM_OTHER = Me.unbtxt_PREV_CASE_NUM
End Sub
Private Sub Form_ApplyFilter(Cancel As Integer, ApplyType As Integer)
'Only On-Apply Filter, then
If Me.CASE_NUM_OTHER <> Me.unbtxt_PREV_CASE_NUM Then
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
End If
End Sub
Private Sub Form_BeforeInsert(Cancel As Integer)
If Me.CASE_NUM_OTHER <> Me.unbtxt_PREV_CASE_NUM Then
MsgBox "Case Numbers are " & Me.CASE_NUM_OTHER.Value &
Me.unbtxt_PREV_CASE_NUM.Value
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
Me.unbtxt_PREV_VEHICLE_CDE = Me.txt_VEHICLE_CDE
Me.unbtxt_PREV_OTHER_CDE = Me.txt_OTHER_CDE
End If
With Me.Parent
If .NewRecord Then
Cancel = True
MsgBox "You Must Enter The Case Record First"
Else
Me.txt_SEQ_NUM = (unbtxt_TtlRecNum + 2)
Me.CASE_NUM_YR_OTHER = Me.unbtxt_PREV_CASE_YR
Me.CASE_NUM_OTHER = Me.unbtxt_PREV_CASE_NUM
rstCASE_OTHERS.AddNew
rstCASE_OTHERS!CASE_NUM_YR = Me.CASE_NUM_YR_OTHER
rstCASE_OTHERS!CASE_NUM = Me.CASE_NUM_OTHER
rstCASE_OTHERS!SEQ_NUM = Me.txt_SEQ_NUM
rstCASE_OTHERS!VEHICLE_CDE = Me.txt_VEHICLE_CDE
rstCASE_OTHERS!OTHER_CDE = Me.txt_OTHER_CDE
rstCASE_OTHERS!OTHER_NME = Me.txt_OTHER_NME
rstCASE_OTHERS!FIRM_NME = Me.txt_FIRM_NME
rstCASE_OTHERS!OTHER_ADDR_TXT = Me.txt_OTHER_ADDR_TXT
rstCASE_OTHERS!OTHER_CITY_NME = Me.txt_OTHER_CITY_NME
rstCASE_OTHERS!OTHER_STATE_CDE = Me.txt_OTHER_STATE_CDE
rstCASE_OTHERS!OTHER_ZIP_CDE = Me.txt_OTHER_ZIP_CDE
rstCASE_OTHERS!UPDATED_DATE = Me.txt_UPDATED_DATE
rstCASE_OTHERS!VEHICLE_CDE = Me.VEHICLE_CDE
rstCASE_OTHERS.Update
End If
End With
Me.Refresh
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord And _
Me.Dirty And _
IsNull(Me.VEHICLE_CDE) = True And _
IsNull(Me.OTHER_CDE) = True And _
IsNull(Me.OTHER_NME) = True And _
IsNull(Me.FIRM_NME) = True And _
IsNull(Me.OTHER_ADDR_TXT) = True And _
IsNull(Me.OTHER_CITY_NME) = True And _
IsNull(Me.OTHER_STATE_CDE) = True And _
IsNull(Me.OTHER_ZIP_CDE) = True Then
Me.Undo
Me.Dirty = False
Cancel = True
ElseIf Me.NewRecord And _
Me.Dirty Then
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
Me.unbtxt_PREV_VEHICLE_CDE = Me.txt_VEHICLE_CDE
Me.unbtxt_PREV_OTHER_CDE = Me.txt_OTHER_CDE
Else
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
Me.unbtxt_PREV_VEHICLE_CDE = Me.txt_VEHICLE_CDE
Me.unbtxt_PREV_OTHER_CDE = Me.txt_OTHER_CDE
End If
End Sub
Private Sub Form_Current()
Me.txt_VEHICLE_CDE.SetFocus
Dim lngCount As String
lngCount = RecordsInTable("TST_FR_CASE_OTHERS", "SEQ_NUM")
Me.Refresh
'the following code should prevent the user from scrolling past
'BOF (Beginning-of-file) and EOF (End-of-File)
If Me.CurrentRecord = lngCount Then
Me.Command75_Next_Record.Enabled = False
Me.Command76_Previous_Record.Enabled = True
MsgBox "There Are No More Records To Display For This Case Number.
If you need to create a New Recordset, press the New Recordset Button"
ElseIf Me.CurrentRecord = 1 Then
Me.Command75_Next_Record.Enabled = True
Me.Command76_Previous_Record.Enabled = False
Else
Me.Command75_Next_Record.Enabled = True
Me.Command76_Previous_Record.Enabled = True
End If
' End of Special code to prevent BOF/EOF Scrolling
Me.unbtxt_CurRecNum = Me.CurrentRecord
Me.unbtxt_TtlRecNum = lngCount
End Sub
Private Sub Form_Load()
Me.CASE_NUM_YR_OTHER.DefaultValue = Nz(Me.OpenArgs, "")
Me.CASE_NUM_OTHER.DefaultValue = Nz(Me.OpenArgs, "")
End Sub
Private Sub Command75_Next_Record_Click()
On Error GoTo Err_Command75_Next_Record_Click
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
Me.unbtxt_PREV_VEHICLE_CDE = Me.txt_VEHICLE_CDE
Me.unbtxt_PREV_OTHER_CDE = Me.txt_OTHER_CDE
DoCmd.GoToRecord , , acNext
Exit_Command75_Next_Record_Click:
Exit Sub
Err_Command75_Next_Record_Click:
MsgBox Err.Description
Resume Exit_Command75_Next_Record_Click
End Sub
Private Sub Command76_Previous_Record_Click()
On Error GoTo Err_Command76_Previous_Record_Click
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
Me.unbtxt_PREV_VEHICLE_CDE = Me.txt_VEHICLE_CDE
Me.unbtxt_PREV_OTHER_CDE = Me.txt_OTHER_CDE
DoCmd.GoToRecord , , acPrevious
Exit_Command76_Previous_Record_Click:
Exit Sub
Err_Command76_Previous_Record_Click:
MsgBox Err.Description
Resume Exit_Command76_Previous_Record_Click
End Sub
Private Sub Command81_Return_Click()
On Error GoTo Err_Command81_Return_Click
DoCmd.Close
Exit_Command81_Return_Click:
Exit Sub
Err_Command81_Return_Click:
MsgBox Err.Description
Resume Exit_Command81_Return_Click
End Sub
Function RecordsInTable(Tablename As String, FieldName As String) As Long
'This code counts the number of records in the Recordset
Dim strSQL As String, _
strTableField As String, _
strTableCase As String, _
strTableYr As String
strTableField = Tablename & ".VEHICLE_CDE"
strTableCase = Tablename & ".CASE_NUM_YR"
strTableYr = Tablename & ".CASE_NUM"
Dim rstCASE_OTHERS As ADODB.Recordset
Set rstCASE_OTHERS = New ADODB.Recordset
strFormYear = Me.CASE_NUM_YR
strFormCase = Me.CASE_NUM
If IsNull(strFormYear) = True Then
strFormYear = Me.unbtxt_PREV_CASE_YR
End If
If IsNull(strFormCase) = True Then
strFormCase = Me.unbtxt_PREV_CASE_NUM
End If
rstCASE_OTHERS.ActiveConnection = CurrentProject.Connection 'allows
current open.connection
rstCASE_OTHERS.CursorType = adOpenDynamic 'allows add, change,
delete, view of records
rstCASE_OTHERS.LockType = adLockOptimistic 'locks record as record
edit starts
rstCASE_OTHERS.Open "SELECT Count(" & strTableField & ") AS [Count] From
" & Tablename & _
" WHERE " & strTableCase & " = " & strFormYear & _
" And " & strTableYr & " = " & strFormCase & ";"
RecordsInTable = rstCASE_OTHERS!Count
'Set rstCASE_OTHERS = Nothing
End Function
Private Sub Command83_Add_New_Record_Click()
On Error GoTo Err_Command83_Add_New_Record_Click
DoCmd.GoToRecord , , acNewRec
Exit_Command83_Add_New_Record_Click:
Exit Sub
Err_Command83_Add_New_Record_Click:
MsgBox Err.Description
Resume Exit_Command83_Add_New_Record_Click
End Sub
Private Sub Command84_Refresh_Form_Click()
On Error GoTo Err_Command84_Refresh_Form_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
Exit_Command84_Refresh_Form_Click:
Exit Sub
Err_Command84_Refresh_Form_Click:
MsgBox Err.Description
Resume Exit_Command84_Refresh_Form_Click
End Sub
Parent form updates primary table, subform of parent form updates/views
secondary table linked to primary via parent/child primary key links.
I need to be able to add records to secondary table (DB2 table), I have
rights to add, update, delete, change, records in db2, so that is not the
issue. It's my code that fails, to new to VB code procedures. Can someone
assist please.
On add records button, I want to clear active screen, allow data entry of
new record and pass this record to secondary table appending this record to
end of existing table. Any clues.
This is the code:
Option Compare Database
Private Sub Command33_Undo_Changes_Click()
On Error GoTo Err_Command33_Undo_Changes_Click
DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
Exit_Command33_Undo_Changes_Click:
Exit Sub
Err_Command33_Undo_Changes_Click:
MsgBox Err.Description
Resume Exit_Command33_Undo_Changes_Click
End Sub
Private Sub Command63_Return_Main_Page_Click()
Me.Parent.SetFocus
End Sub
Private Sub Form_AfterUpdate()
Me.Refresh
Me.CASE_NUM_YR_OTHER = Me.unbtxt_PREV_CASE_YR
Me.CASE_NUM_OTHER = Me.unbtxt_PREV_CASE_NUM
End Sub
Private Sub Form_ApplyFilter(Cancel As Integer, ApplyType As Integer)
'Only On-Apply Filter, then
If Me.CASE_NUM_OTHER <> Me.unbtxt_PREV_CASE_NUM Then
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
End If
End Sub
Private Sub Form_BeforeInsert(Cancel As Integer)
If Me.CASE_NUM_OTHER <> Me.unbtxt_PREV_CASE_NUM Then
MsgBox "Case Numbers are " & Me.CASE_NUM_OTHER.Value &
Me.unbtxt_PREV_CASE_NUM.Value
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
Me.unbtxt_PREV_VEHICLE_CDE = Me.txt_VEHICLE_CDE
Me.unbtxt_PREV_OTHER_CDE = Me.txt_OTHER_CDE
End If
With Me.Parent
If .NewRecord Then
Cancel = True
MsgBox "You Must Enter The Case Record First"
Else
Me.txt_SEQ_NUM = (unbtxt_TtlRecNum + 2)
Me.CASE_NUM_YR_OTHER = Me.unbtxt_PREV_CASE_YR
Me.CASE_NUM_OTHER = Me.unbtxt_PREV_CASE_NUM
rstCASE_OTHERS.AddNew
rstCASE_OTHERS!CASE_NUM_YR = Me.CASE_NUM_YR_OTHER
rstCASE_OTHERS!CASE_NUM = Me.CASE_NUM_OTHER
rstCASE_OTHERS!SEQ_NUM = Me.txt_SEQ_NUM
rstCASE_OTHERS!VEHICLE_CDE = Me.txt_VEHICLE_CDE
rstCASE_OTHERS!OTHER_CDE = Me.txt_OTHER_CDE
rstCASE_OTHERS!OTHER_NME = Me.txt_OTHER_NME
rstCASE_OTHERS!FIRM_NME = Me.txt_FIRM_NME
rstCASE_OTHERS!OTHER_ADDR_TXT = Me.txt_OTHER_ADDR_TXT
rstCASE_OTHERS!OTHER_CITY_NME = Me.txt_OTHER_CITY_NME
rstCASE_OTHERS!OTHER_STATE_CDE = Me.txt_OTHER_STATE_CDE
rstCASE_OTHERS!OTHER_ZIP_CDE = Me.txt_OTHER_ZIP_CDE
rstCASE_OTHERS!UPDATED_DATE = Me.txt_UPDATED_DATE
rstCASE_OTHERS!VEHICLE_CDE = Me.VEHICLE_CDE
rstCASE_OTHERS.Update
End If
End With
Me.Refresh
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord And _
Me.Dirty And _
IsNull(Me.VEHICLE_CDE) = True And _
IsNull(Me.OTHER_CDE) = True And _
IsNull(Me.OTHER_NME) = True And _
IsNull(Me.FIRM_NME) = True And _
IsNull(Me.OTHER_ADDR_TXT) = True And _
IsNull(Me.OTHER_CITY_NME) = True And _
IsNull(Me.OTHER_STATE_CDE) = True And _
IsNull(Me.OTHER_ZIP_CDE) = True Then
Me.Undo
Me.Dirty = False
Cancel = True
ElseIf Me.NewRecord And _
Me.Dirty Then
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
Me.unbtxt_PREV_VEHICLE_CDE = Me.txt_VEHICLE_CDE
Me.unbtxt_PREV_OTHER_CDE = Me.txt_OTHER_CDE
Else
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
Me.unbtxt_PREV_VEHICLE_CDE = Me.txt_VEHICLE_CDE
Me.unbtxt_PREV_OTHER_CDE = Me.txt_OTHER_CDE
End If
End Sub
Private Sub Form_Current()
Me.txt_VEHICLE_CDE.SetFocus
Dim lngCount As String
lngCount = RecordsInTable("TST_FR_CASE_OTHERS", "SEQ_NUM")
Me.Refresh
'the following code should prevent the user from scrolling past
'BOF (Beginning-of-file) and EOF (End-of-File)
If Me.CurrentRecord = lngCount Then
Me.Command75_Next_Record.Enabled = False
Me.Command76_Previous_Record.Enabled = True
MsgBox "There Are No More Records To Display For This Case Number.
If you need to create a New Recordset, press the New Recordset Button"
ElseIf Me.CurrentRecord = 1 Then
Me.Command75_Next_Record.Enabled = True
Me.Command76_Previous_Record.Enabled = False
Else
Me.Command75_Next_Record.Enabled = True
Me.Command76_Previous_Record.Enabled = True
End If
' End of Special code to prevent BOF/EOF Scrolling
Me.unbtxt_CurRecNum = Me.CurrentRecord
Me.unbtxt_TtlRecNum = lngCount
End Sub
Private Sub Form_Load()
Me.CASE_NUM_YR_OTHER.DefaultValue = Nz(Me.OpenArgs, "")
Me.CASE_NUM_OTHER.DefaultValue = Nz(Me.OpenArgs, "")
End Sub
Private Sub Command75_Next_Record_Click()
On Error GoTo Err_Command75_Next_Record_Click
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
Me.unbtxt_PREV_VEHICLE_CDE = Me.txt_VEHICLE_CDE
Me.unbtxt_PREV_OTHER_CDE = Me.txt_OTHER_CDE
DoCmd.GoToRecord , , acNext
Exit_Command75_Next_Record_Click:
Exit Sub
Err_Command75_Next_Record_Click:
MsgBox Err.Description
Resume Exit_Command75_Next_Record_Click
End Sub
Private Sub Command76_Previous_Record_Click()
On Error GoTo Err_Command76_Previous_Record_Click
Me.unbtxt_PREV_CASE_YR = Me.CASE_NUM_YR_OTHER
Me.unbtxt_PREV_CASE_NUM = Me.CASE_NUM_OTHER
Me.unbtxt_PREV_SEQ_NUM = Me.txt_SEQ_NUM
Me.unbtxt_PREV_VEHICLE_CDE = Me.txt_VEHICLE_CDE
Me.unbtxt_PREV_OTHER_CDE = Me.txt_OTHER_CDE
DoCmd.GoToRecord , , acPrevious
Exit_Command76_Previous_Record_Click:
Exit Sub
Err_Command76_Previous_Record_Click:
MsgBox Err.Description
Resume Exit_Command76_Previous_Record_Click
End Sub
Private Sub Command81_Return_Click()
On Error GoTo Err_Command81_Return_Click
DoCmd.Close
Exit_Command81_Return_Click:
Exit Sub
Err_Command81_Return_Click:
MsgBox Err.Description
Resume Exit_Command81_Return_Click
End Sub
Function RecordsInTable(Tablename As String, FieldName As String) As Long
'This code counts the number of records in the Recordset
Dim strSQL As String, _
strTableField As String, _
strTableCase As String, _
strTableYr As String
strTableField = Tablename & ".VEHICLE_CDE"
strTableCase = Tablename & ".CASE_NUM_YR"
strTableYr = Tablename & ".CASE_NUM"
Dim rstCASE_OTHERS As ADODB.Recordset
Set rstCASE_OTHERS = New ADODB.Recordset
strFormYear = Me.CASE_NUM_YR
strFormCase = Me.CASE_NUM
If IsNull(strFormYear) = True Then
strFormYear = Me.unbtxt_PREV_CASE_YR
End If
If IsNull(strFormCase) = True Then
strFormCase = Me.unbtxt_PREV_CASE_NUM
End If
rstCASE_OTHERS.ActiveConnection = CurrentProject.Connection 'allows
current open.connection
rstCASE_OTHERS.CursorType = adOpenDynamic 'allows add, change,
delete, view of records
rstCASE_OTHERS.LockType = adLockOptimistic 'locks record as record
edit starts
rstCASE_OTHERS.Open "SELECT Count(" & strTableField & ") AS [Count] From
" & Tablename & _
" WHERE " & strTableCase & " = " & strFormYear & _
" And " & strTableYr & " = " & strFormCase & ";"
RecordsInTable = rstCASE_OTHERS!Count
'Set rstCASE_OTHERS = Nothing
End Function
Private Sub Command83_Add_New_Record_Click()
On Error GoTo Err_Command83_Add_New_Record_Click
DoCmd.GoToRecord , , acNewRec
Exit_Command83_Add_New_Record_Click:
Exit Sub
Err_Command83_Add_New_Record_Click:
MsgBox Err.Description
Resume Exit_Command83_Add_New_Record_Click
End Sub
Private Sub Command84_Refresh_Form_Click()
On Error GoTo Err_Command84_Refresh_Form_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
Exit_Command84_Refresh_Form_Click:
Exit Sub
Err_Command84_Refresh_Form_Click:
MsgBox Err.Description
Resume Exit_Command84_Refresh_Form_Click
End Sub