object required error

deb

Active Member
Joined
Feb 1, 2003
Messages
400
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
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
I found my error. setfocus was set to a field that was previously deleted.
 
Upvote 0

Forum statistics

Threads
1,223,894
Messages
6,175,254
Members
452,623
Latest member
Techenthusiast

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top