office 365 ms access
Form f_Site and subform f_site_variation.
Form uses list box to find records of a specific alphabet. Also allows the new Site record.
Sub Form adds a variation of the Site name, if any.
Getting an "Object required" error when clicking add site variation button. This button is to add a new record using the subform.
It is driving me crazy trying to find the reason for error.
Here is the code for my form:
Option Compare Database
Option Explicit
'Me.Field_Form_Sub.Form.AllowAdditions = True
Private Sub btnAddSite_Click()
On Error GoTo Err_btnAddSite_Click
Me.AllowAdditions = True
DoCmd.GoToRecord , , acNewRec
Site.SetFocus
Me.lstSite.Requery
Exit_btnAddSite_Click:
Exit Sub
Err_btnAddSite_Click:
MsgBox Err.Description
Resume Exit_btnAddSite_Click
End Sub
Private Sub btnDelSite_Click()
On Error GoTo Err_btnDelSite_Click
If Me.NewRecord Then
Me.Undo
End If
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
Me.lstSite.Requery
Exit_btnDelSite_Click:
Exit Sub
Err_btnDelSite_Click:
MsgBox Err.Description
Resume Exit_btnDelSite_Click
End Sub
Private Sub Form_Activate()
' Me.AllowAdditions = True
' DoCmd.GoToRecord acDataForm, Me.Name, acNewRec
' Me.txtSiteNameFilter = "A"
' Me.lstSite.Requery
End Sub
Private Sub Form_AfterUpdate()
MsgBox "Record Saved"
Me.lstSite.Requery
End Sub
Private Sub Form_Open(Cancel As Integer)
' DoCmd.Maximize
' Me.AllowAdditions = True
' DoCmd.GoToRecord acDataForm, Me.Name, acNewRec
' Me.txtSiteNameFilter = "A"
' Me.lstSite.Requery
End Sub
Private Sub grpSiteNameFilter_Click()
Select Case grpSiteNameFilter
Case 1
Me.txtSiteNameFilter = "A"
Me.lstSite.Requery
Case 2
Me.txtSiteNameFilter = "B"
Me.lstSite.Requery
Case 3
Me.txtSiteNameFilter = "C"
Me.lstSite.Requery
Case 4
Me.txtSiteNameFilter = "D"
Me.lstSite.Requery
Case 5
Me.txtSiteNameFilter = "E"
Me.lstSite.Requery
Case 6
Me.txtSiteNameFilter = "F"
Me.lstSite.Requery
Case 7
Me.txtSiteNameFilter = "G"
Me.lstSite.Requery
Case 8
Me.txtSiteNameFilter = "H"
Me.lstSite.Requery
Case 9
Me.txtSiteNameFilter = "I"
Me.lstSite.Requery
Case 10
Me.txtSiteNameFilter = "J"
Me.lstSite.Requery
Case 11
Me.txtSiteNameFilter = "K"
Me.lstSite.Requery
Case 12
Me.txtSiteNameFilter = "L"
Me.lstSite.Requery
Case 13
Me.txtSiteNameFilter = "M"
Me.lstSite.Requery
Case 14
Me.txtSiteNameFilter = "N"
Me.lstSite.Requery
Case 15
Me.txtSiteNameFilter = "O"
Me.lstSite.Requery
Case 16
Me.txtSiteNameFilter = "P"
Me.lstSite.Requery
Case 17
Me.txtSiteNameFilter = "Q"
Me.lstSite.Requery
Case 18
Me.txtSiteNameFilter = "R"
Me.lstSite.Requery
Case 19
Me.txtSiteNameFilter = "S"
Me.lstSite.Requery
Case 20
Me.txtSiteNameFilter = "T"
Me.lstSite.Requery
Case 21
Me.txtSiteNameFilter = "U"
Me.lstSite.Requery
Case 22
Me.txtSiteNameFilter = "V"
Me.lstSite.Requery
Case 23
Me.txtSiteNameFilter = "W"
Me.lstSite.Requery
Case 24
Me.txtSiteNameFilter = "X"
Me.lstSite.Requery
Case 25
Me.txtSiteNameFilter = "Y"
Me.lstSite.Requery
Case 26
Me.txtSiteNameFilter = "Z"
Me.lstSite.Requery
Case 27
Me.txtSiteNameFilter = "*"
Me.lstSite.Requery
End Select
Me.RecordSource = "Select * FROM t_Sites WHERE Site Like """ & txtSiteNameFilter & "*"""
Me.Requery
End Sub
Private Sub lstSite_Click()
' Find the record that matches the control.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[SiteID] = " & Str(Me![lstSite])
Me.Bookmark = rs.Bookmark
Me.lstSite = Me.SiteID
End Sub
Private Sub Site_BeforeUpdate(Cancel As Integer)
Dim SID As String
Dim stLinkCriteria As String
Dim rsc As DAO.Recordset
Set rsc = Me.RecordsetClone
SID = Me.Site.Value
stLinkCriteria = "[Site]=" & "'" & SID & "'"
'Check StudentDetails table for duplicate StudentNumber
If DCount("Site", "t_Sites", _
stLinkCriteria) > 0 Then
'Undo duplicate entry
Me.Undo
'Message box warning of duplication
MsgBox "Warning Site " _
& SID & " has already been entered." _
& vbCr & vbCr & "You will now been taken to the record.", _
vbInformation, "Duplicate Information"
'Go to record of original Student Number
rsc.FindFirst stLinkCriteria
Me.Bookmark = rsc.Bookmark
End If
Set rsc = Nothing
End Sub
Private Sub Site_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not currently in the table." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Site...")
If i = vbYes Then
strSQL = "Insert Into t_Sites ([Site]) " & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
End Sub
Private Sub Site_Type_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not currently in the table." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Site Type...")
If i = vbYes Then
strSQL = "Insert Into t_SiteType ([SiteType]) " & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
End Sub
Private Sub Country_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not currently in the table." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Country...")
If i = vbYes Then
strSQL = "Insert Into t_Country ([Country]) " & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
End Sub
Private Sub Customer_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not currently in the table." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Customer...")
If i = vbYes Then
strSQL = "Insert Into t_Customer ([Customer]) " & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
End Sub
Private Sub District_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not currently in the table." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown District...")
If i = vbYes Then
strSQL = "Insert Into t_District ([District]) " & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
End Sub
Here is the code on subform:
Option Compare Database
Private Sub btnAddVariation_Click()
On Error GoTo Err_btnAddVariation_Click
Me.AllowAdditions = True
DoCmd.GoToRecord , , acNewRec
Site.SetFocus
Exit_btnAddVariation_Click:
Exit Sub
Err_btnAddVariation_Click:
MsgBox Err.Description
Resume Exit_btnAddVariation_Click
End Sub
Private Sub btnDelVariation_Click()
On Error GoTo Err_btnDelVariation_Click
If Me.NewRecord Then
Me.Undo
End If
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
Exit_btnDelVariation_Click:
Exit Sub
Err_btnDelVariation_Click:
MsgBox Err.Description
Resume Exit_btnDelVariation_Click
End Sub
Private Sub Form_AfterInsert()
Me.AllowAdditions = False
End Sub
Private Sub Form_Open(Cancel As Integer)
Me.AllowAdditions = False
End Sub
Form f_Site and subform f_site_variation.
Form uses list box to find records of a specific alphabet. Also allows the new Site record.
Sub Form adds a variation of the Site name, if any.
Getting an "Object required" error when clicking add site variation button. This button is to add a new record using the subform.
It is driving me crazy trying to find the reason for error.
Here is the code for my form:
Option Compare Database
Option Explicit
'Me.Field_Form_Sub.Form.AllowAdditions = True
Private Sub btnAddSite_Click()
On Error GoTo Err_btnAddSite_Click
Me.AllowAdditions = True
DoCmd.GoToRecord , , acNewRec
Site.SetFocus
Me.lstSite.Requery
Exit_btnAddSite_Click:
Exit Sub
Err_btnAddSite_Click:
MsgBox Err.Description
Resume Exit_btnAddSite_Click
End Sub
Private Sub btnDelSite_Click()
On Error GoTo Err_btnDelSite_Click
If Me.NewRecord Then
Me.Undo
End If
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
Me.lstSite.Requery
Exit_btnDelSite_Click:
Exit Sub
Err_btnDelSite_Click:
MsgBox Err.Description
Resume Exit_btnDelSite_Click
End Sub
Private Sub Form_Activate()
' Me.AllowAdditions = True
' DoCmd.GoToRecord acDataForm, Me.Name, acNewRec
' Me.txtSiteNameFilter = "A"
' Me.lstSite.Requery
End Sub
Private Sub Form_AfterUpdate()
MsgBox "Record Saved"
Me.lstSite.Requery
End Sub
Private Sub Form_Open(Cancel As Integer)
' DoCmd.Maximize
' Me.AllowAdditions = True
' DoCmd.GoToRecord acDataForm, Me.Name, acNewRec
' Me.txtSiteNameFilter = "A"
' Me.lstSite.Requery
End Sub
Private Sub grpSiteNameFilter_Click()
Select Case grpSiteNameFilter
Case 1
Me.txtSiteNameFilter = "A"
Me.lstSite.Requery
Case 2
Me.txtSiteNameFilter = "B"
Me.lstSite.Requery
Case 3
Me.txtSiteNameFilter = "C"
Me.lstSite.Requery
Case 4
Me.txtSiteNameFilter = "D"
Me.lstSite.Requery
Case 5
Me.txtSiteNameFilter = "E"
Me.lstSite.Requery
Case 6
Me.txtSiteNameFilter = "F"
Me.lstSite.Requery
Case 7
Me.txtSiteNameFilter = "G"
Me.lstSite.Requery
Case 8
Me.txtSiteNameFilter = "H"
Me.lstSite.Requery
Case 9
Me.txtSiteNameFilter = "I"
Me.lstSite.Requery
Case 10
Me.txtSiteNameFilter = "J"
Me.lstSite.Requery
Case 11
Me.txtSiteNameFilter = "K"
Me.lstSite.Requery
Case 12
Me.txtSiteNameFilter = "L"
Me.lstSite.Requery
Case 13
Me.txtSiteNameFilter = "M"
Me.lstSite.Requery
Case 14
Me.txtSiteNameFilter = "N"
Me.lstSite.Requery
Case 15
Me.txtSiteNameFilter = "O"
Me.lstSite.Requery
Case 16
Me.txtSiteNameFilter = "P"
Me.lstSite.Requery
Case 17
Me.txtSiteNameFilter = "Q"
Me.lstSite.Requery
Case 18
Me.txtSiteNameFilter = "R"
Me.lstSite.Requery
Case 19
Me.txtSiteNameFilter = "S"
Me.lstSite.Requery
Case 20
Me.txtSiteNameFilter = "T"
Me.lstSite.Requery
Case 21
Me.txtSiteNameFilter = "U"
Me.lstSite.Requery
Case 22
Me.txtSiteNameFilter = "V"
Me.lstSite.Requery
Case 23
Me.txtSiteNameFilter = "W"
Me.lstSite.Requery
Case 24
Me.txtSiteNameFilter = "X"
Me.lstSite.Requery
Case 25
Me.txtSiteNameFilter = "Y"
Me.lstSite.Requery
Case 26
Me.txtSiteNameFilter = "Z"
Me.lstSite.Requery
Case 27
Me.txtSiteNameFilter = "*"
Me.lstSite.Requery
End Select
Me.RecordSource = "Select * FROM t_Sites WHERE Site Like """ & txtSiteNameFilter & "*"""
Me.Requery
End Sub
Private Sub lstSite_Click()
' Find the record that matches the control.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[SiteID] = " & Str(Me![lstSite])
Me.Bookmark = rs.Bookmark
Me.lstSite = Me.SiteID
End Sub
Private Sub Site_BeforeUpdate(Cancel As Integer)
Dim SID As String
Dim stLinkCriteria As String
Dim rsc As DAO.Recordset
Set rsc = Me.RecordsetClone
SID = Me.Site.Value
stLinkCriteria = "[Site]=" & "'" & SID & "'"
'Check StudentDetails table for duplicate StudentNumber
If DCount("Site", "t_Sites", _
stLinkCriteria) > 0 Then
'Undo duplicate entry
Me.Undo
'Message box warning of duplication
MsgBox "Warning Site " _
& SID & " has already been entered." _
& vbCr & vbCr & "You will now been taken to the record.", _
vbInformation, "Duplicate Information"
'Go to record of original Student Number
rsc.FindFirst stLinkCriteria
Me.Bookmark = rsc.Bookmark
End If
Set rsc = Nothing
End Sub
Private Sub Site_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not currently in the table." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Site...")
If i = vbYes Then
strSQL = "Insert Into t_Sites ([Site]) " & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
End Sub
Private Sub Site_Type_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not currently in the table." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Site Type...")
If i = vbYes Then
strSQL = "Insert Into t_SiteType ([SiteType]) " & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
End Sub
Private Sub Country_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not currently in the table." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Country...")
If i = vbYes Then
strSQL = "Insert Into t_Country ([Country]) " & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
End Sub
Private Sub Customer_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not currently in the table." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Customer...")
If i = vbYes Then
strSQL = "Insert Into t_Customer ([Customer]) " & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
End Sub
Private Sub District_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not currently in the table." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown District...")
If i = vbYes Then
strSQL = "Insert Into t_District ([District]) " & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If
End Sub
Here is the code on subform:
Option Compare Database
Private Sub btnAddVariation_Click()
On Error GoTo Err_btnAddVariation_Click
Me.AllowAdditions = True
DoCmd.GoToRecord , , acNewRec
Site.SetFocus
Exit_btnAddVariation_Click:
Exit Sub
Err_btnAddVariation_Click:
MsgBox Err.Description
Resume Exit_btnAddVariation_Click
End Sub
Private Sub btnDelVariation_Click()
On Error GoTo Err_btnDelVariation_Click
If Me.NewRecord Then
Me.Undo
End If
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
Exit_btnDelVariation_Click:
Exit Sub
Err_btnDelVariation_Click:
MsgBox Err.Description
Resume Exit_btnDelVariation_Click
End Sub
Private Sub Form_AfterInsert()
Me.AllowAdditions = False
End Sub
Private Sub Form_Open(Cancel As Integer)
Me.AllowAdditions = False
End Sub