I am having issues with an Access Database that we have used for years with no issues, it was created around 2004 I think.
Anyway, while trying to save a persons information I got the Run-time error '424': Object required. After some troubleshooting I noticed that it is only about 1% of the records that result in this error and it works fine for the other 99%. Also, it doesn't just happen on my computer, it gives the same error for those specific records on every computer in the office.
When I click debug it displays this code and the line that I colored red is highlighted...any ideas?:
Anyway, while trying to save a persons information I got the Run-time error '424': Object required. After some troubleshooting I noticed that it is only about 1% of the records that result in this error and it works fine for the other 99%. Also, it doesn't just happen on my computer, it gives the same error for those specific records on every computer in the office.
When I click debug it displays this code and the line that I colored red is highlighted...any ideas?:
Code:
Option Compare Database
Dim globReportName
Private Sub CmdRunReport_Click()
On Error GoTo CmdRunReportError
Dim strWhere As String
Dim strDocName As String
If Me.FilterOn Then
strWhere = Me.Filter
End If
strDocName = globReportName
DoCmd.OpenReport strDocName, acViewPreview, , strWhere
CmdRunReportExit:
Exit Sub
CmdRunReportError:
MsgBox Err.Description
Resume CmdRunReportExit
End Sub
Private Sub ComboReportList_AfterUpdate()
globReportName = ComboReportList
End Sub
Private Sub ComboReportList_Click()
globReportName = ComboReportList
End Sub
Public Function GetString(szStr As Variant, bReturnNULL As Boolean) As Variant
If (bReturnNULL) Then
GetString = IIf(szStr = "", Null, szStr)
Else
GetString = IIf(IsNull(szStr), "", szStr)
End If
End Function
Private Sub Form_BeforeUpdate(Cancel As Integer)
'-------------------------------------------------------------------------------------
' Function: Event Handler for 'Before Update' for the Form
' Purpose: This routine will ensure that the participant and membership data in the
' SQL Server database is consistent with any updates made to this record.
'-------------------------------------------------------------------------------------
If Is4HMember() Then
' Validate the data
If Not IsValidated() Then
Cancel = True
x = MsgBox("The data you entered did not pass validation rules for a 4H member record. Please ensure the following: " & Chr(13) & Chr(10) & Chr(10) & "1. First Name, Last Name, Address Line 1, City, State and Zip all have entries" & Chr(13) & Chr(10) & "2. Telephone Number, if entered, is 7 or 10 digits, excluding formatting characters" & Chr(13) & Chr(10) & "3. Zip Code, if entered, is 5 or 9 digits, excluding formatting characters", vbInformation, "Validation Error")
Else
' Data was valid, so check if this member is listed in the XRef table which indicates that
' he/she has been added to the SQL Server database.
Set dbs4H = CurrentDb
Set rsXRefInfo = dbs4H.OpenRecordset("Select * from 4H_XRef Where t4h_AccessID = " & Str(Forms![MailingList Form]!AddressID))
If rsXRefInfo.BOF Then
' BOF here indicates that no records exist in the record set and the
' Access ID was not found in the XREF table which in turn indicates
' that record has just been added to be a 4H member.
'
' However, we must ensure this is not an update to to a just Added record that
' has not been processed by the Event Processor yet. If it is, then, we will not
' add a 2nd sychnronization record for the same add.
Set rsCheckDuplicateAdd = dbs4H.OpenRecordset("Select * from 4H_Synchronization Where ts_AccessID = " & Str(Forms![MailingList Form]!AddressID) & " and ts_Action = 'Add' and ts_Status in ('Open', 'Error')")
If rsCheckDuplicateAdd.BOF Then
' No other Synch record found, so continue with add
' Populate the new synchronization record.
' Add a new record to the synchronization table.
Set rsSyncTable = dbs4H.OpenRecordset("4H_Synchronization")
rsSyncTable.AddNew
rsSyncTable![ts_AccessID] = Forms![MailingList Form]!AddressID
rsSyncTable![ts_Action] = "Add"
rsSyncTable![ts_4HMember] = True
rsSyncTable![ts_Status] = "Open"
' Save the record to the table.
rsSyncTable.Update
End If
Else
'
' The XREF record was found, which means that the member has already been defined
' as a 4H member at some time in the past. Write an Update record to the Synch table
' to verify that the participant identified from the XREF table is still listed on
' that membership.
' Add a new record to the synchronization table.
Set rsSyncTable = dbs4H.OpenRecordset("4H_Synchronization")
rsSyncTable.AddNew
rsSyncTable![ts_AccessID] = Forms![MailingList Form]!AddressID
rsSyncTable![ts_SQLID] = rsXRefInfo![t4h_SQLID]
rsSyncTable![ts_Action] = "Update"
rsSyncTable![ts_4HMember] = True
rsSyncTable![ts_Status] = "Open"
' Save the record to the table.
rsSyncTable.Update
End If
' Clean-up
[B][COLOR="Red"] rsSyncTable.Close[/COLOR][/B]
rsXRefInfo.Close
dbs4H.Close
Set rsSyncTable = Nothing
Set rsXRefInfo = Nothing
Set dbs4H = Nothing
End If
Else
' Not currently shown as a 4H member, so we need to check if the Access ID exists
' in the XREF table indicating that the member was a 4H member before this update.
Set dbs4H = CurrentDb
Set rsXRefInfo = dbs4H.OpenRecordset("Select * from 4H_XRef Where t4h_AccessID = " & Str(Forms![MailingList Form]!AddressID))
If Not rsXRefInfo.BOF Then
' NOT BOF here indicates that a record was found in the XREF table which in turn indicates
' that this was a 4H member.
' Add a new record to the synchronization table.
Set rsSyncTable = dbs4H.OpenRecordset("4H_Synchronization")
rsSyncTable.AddNew
' Populate the new synchronization record.
rsSyncTable![ts_AccessID] = Forms![MailingList Form]!AddressID
rsSyncTable![ts_SQLID] = rsXRefInfo![t4h_SQLID]
rsSyncTable![ts_Action] = "Update"
rsSyncTable![ts_4HMember] = False
rsSyncTable![ts_Status] = "Open"
' Save the record to the table.
rsSyncTable.Update
' Clean-up
rsSyncTable.Close
Set rsSyncTable = Nothing
Else
' If not XREF record exists, just ensure that it is not because the Add has not yet occurred
' on the SQL side, so check the Sync table for an Open or Error record for the same Access ID and delete
' if found.
Set rsSyncTable = dbs4H.OpenRecordset("Select * from 4H_Synchronization Where ts_AccessID = " & Str(Forms![MailingList Form]!AddressID) & " and ts_Status in ('Open', 'Error')")
If Not rsSyncTable.BOF Then
' Sync record found so delete it
rsSyncTable.Delete
End If
' Clean-up
rsSyncTable.Close
Set rsSyncTable = Nothing
End If
' Clean-up
rsXRefInfo.Close
dbs4H.Close
Set rsXRefInfo = Nothing
Set dbs4H = Nothing
End If
End Sub
Private Sub Form_Delete(Cancel As Integer)
'-------------------------------------------------------------------------------------
' This subroutine will add a record to the synchronization table to prompt the CERO
' application to remove the 4H membership for this deleted record.
'-------------------------------------------------------------------------------------
If Is4HMember() Then
'-------------------------------------------------------------------------------------
' Add a record to the 4H_Synchronization table. This table will be read and processed
' by the CERO application.
'-------------------------------------------------------------------------------------
Set dbs4H = CurrentDb
Set rsSyncTable = dbs4H.OpenRecordset("4H_Synchronization")
Set rsXRefInfo = dbs4H.OpenRecordset("Select * from 4H_XRef Where t4h_AccessID = " & Str(Forms![MailingList Form]!AddressID))
If Not rsXRefInfo.BOF Then
' NOT BOF here indicates that a record was found in the XREF table which in turn indicates
' that this was a 4H member.
' Add a new record to the synchronization table.
rsSyncTable.AddNew
' Populate the new synchronization record. This is added as an Update record with
' False since we only want to remove the participant from the 4H membership is SQL
' and not remove the participant him/herself.
'
rsSyncTable![ts_AccessID] = Forms![MailingList Form]!AddressID
rsSyncTable![ts_SQLID] = rsXRefInfo![t4h_SQLID]
rsSyncTable![ts_Action] = "Delete"
rsSyncTable![ts_4HMember] = False
rsSyncTable![ts_Status] = "Open"
' Save the record to the table.
rsSyncTable.Update
Else
' If not XREF record exists, just ensure that it is not because the Add has not yet occurred
' on the SQL side, so check the Sync table for an Open record for the same Access ID and delete
' if found.
Set rsSyncTable = dbs4H.OpenRecordset("Select * from 4H_Synchronization Where ts_AccessID = " & Str(Forms![MailingList Form]!AddressID) & " and ts_Status in ('Open', 'Error')")
If Not rsSyncTable.BOF Then
' Sync record found so delete it
rsSyncTable.Delete
End If
End If
' Clean-up
rsSyncTable.Close
rsXRefInfo.Close
dbs4H.Close
Set rsSyncTable = Nothing
Set rsXRefInfo = Nothing
Set dbs4H = Nothing
End If
End Sub
Private Sub Form_Dirty(Cancel As Integer)
Me.DateUpdated = Now()
End Sub
'----------------------------------
' Function: Event Handler for CASSAgent button.
' Purpose: This event is fired every time the user clicks on the CASS Agent button. It will
' also be called if you explicitly call CASSAgent.DoClick()
' Notes: There are two main sections to this function.
' 1) Setup properties for the batch process, see documentation for CASSAgent.BeginBatchProcessing
' 2) For every record in your database, do the following:
' I) Get current address from the database
' II)Call CASSAgent.CertifyAddress, note the first parameter is the record id of the record.
' III) Save address returned by CertifyAddress.
' IV) Move to next record in record set.
'----------------------------------
Public Sub CASSAgent_Click()
Dim szFormName As String
Dim szIdx As String, szFirstName As String, szLastName As String, szBusiness As String, szAddressLine2 As String, szAddressLine1 As String, szCity As String, szState As String, szZip As String, szCarRt As String, szLOTNum As String, szDPC As String, szCASSDate As String
Dim nRecords As Long, nIdx As Long, nErrorCodes As Long, nResult As Long, nCASSDate As Long
Dim bContinue As Boolean
On Error GoTo Error_Occurred
' Save current record
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
' Get number of records in recordset
Me.Form.RecordsetClone.MoveLast
Me.Form.RecordsetClone.MoveFirst
nRecords = Me.Form.RecordsetClone.RecordCount
' Preprocessing info: Name of Form (Printed on Form 3553), number of records, and CASS process flag (see documentation)
szFormName = Me.FormName
bContinue = CASSAgent.BeginBatchProcessing(szFormName, nRecords, 5)
If (bContinue) Then
DoCmd.Minimize
If Me.Form.RecordsetClone.Updatable Then
For nIdx = 0 To nRecords - 1
szIdx = nIdx + 1
' Get current record from recordset.
GetFieldInfoBatch szFirstName, szLastName, szBusiness, szAddressLine2, szAddressLine1, szCity, szState, szZip, szCarRt, szLOTNum, szDPC, nCASSDate
' Pass record to CASS Agent for certification.
nResult = CASSAgent.CertifyAddress(szIdx, szFirstName, szLastName, szBusiness, szAddressLine2, szAddressLine1, szCity, szState, szZip, szCarRt, szLOTNum, szDPC, nErrorCodes, nCASSDate)
' Save returned information.
SetFieldInfoBatch szFirstName, szLastName, szBusiness, szAddressLine2, szAddressLine1, szCity, szState, szZip, szCarRt, szLOTNum, szDPC, nErrorCodes, nCASSDate
' Return valid less than 0 from CertifyAddress means that the user canceled or an error occurred.
If (nResult < 0) Then
GoTo Exit_CertificationSub
End If
' Set bookmark to the next record.
Me.Form.RecordsetClone.MoveNext
Next nIdx
End If
Me.Form.RecordsetClone.MoveFirst
End If
Exit_CertificationSub:
DoCmd.Restore
Exit Sub
Error_Occurred:
MsgBox Err.Description
Resume Exit_CertificationSub
End Sub
'----------------------------------
' Function: Event Handler for CASSAgent button.
' Purpose: This event is fired once for every addres that is Kept during the Review of Errors
' stage of the batch processing.
' Notes: The RecordID is the same that was passed in during CertifyAddress
'----------------------------------
Private Sub CASSAgent_SaveAddress(RecordID As String, szFirstName As String, szLastName As String, szBusiness As String, szAddressLine2 As String, szAddressLine1 As String, szCity As String, szState As String, szZip As String, szCarRt As String, szLOTNum As String, szDPC As String, nErrorCodes As Long, nDate As Long)
Dim nRecord As Long
nRecord = RecordID - 1
Me.Form.RecordsetClone.MoveFirst
Me.Form.RecordsetClone.Move nRecord
SetFieldInfoBatch szFirstName, szLastName, szBusiness, szAddressLine2, szAddressLine1, szCity, szState, szZip, szCarRt, szLOTNum, szDPC, nErrorCodes, nDate
Form.Refresh
End Sub
Private Sub GetFieldInfoBatch(szFirstName, szLastName, szBusiness, szAddressLine2, szAddressLine1, szCity, szState, szZip, szCarRt, szLOTNum, szDPC As String, nCASSDate As Long)
With Me.Form.RecordsetClone
szFirstName = GetString(![FirstName], False)
szLastName = GetString(![LastName], False)
szBusiness = GetString(![Business], False)
szAddressLine2 = GetString(![AddressLine2], False)
szAddressLine1 = GetString(![AddressLine1], False)
szCity = GetString(![City], False)
szState = GetString(![AREA_STATE], False)
szZip = GetString(![ZipCode], False)
szCarRt = GetString(![CarRT], False)
szLOTNum = GetString(![LotNum], False)
szDPC = GetString(![DPC], False)
nCASSDate = IIf(IsNull(![CASSDate]), 0, ![CASSDate])
End With
End Sub
Private Sub SetFieldInfoBatch(ByVal szFirstName, szLastName, szBusiness, szAddressLine2, szAddressLine1, szCity, szState, szZip, szCarRt, szLOTNum, szDPC As String, nErrorCodes As Long, nCASSDate As Long)
Dim szCountyName As String, nCountyCode As Long
With Me.Form.RecordsetClone
.Edit
![FirstName] = GetString(szFirstName, True)
![LastName] = GetString(szLastName, True)
![Business] = GetString(szBusiness, True)
![AddressLine2] = GetString(szAddressLine2, True)
![AddressLine1] = GetString(szAddressLine1, True)
![City] = GetString(szCity, True)
![AREA_STATE] = GetString(szState, True)
![ZipCode] = GetString(szZip, True)
![CarRT] = GetString(szCarRt, True)
![LotNum] = GetString(szLOTNum, True)
![DPC] = GetString(szDPC, True)
![CASSDate] = nCASSDate
![ErrorCodes] = nErrorCodes
.Update
End With
End Sub
Private Sub Form_Open(Cancel As Integer)
End Sub
'----------------------------------
' Function: Event Handler for Presort Agent button.
' Purpose: This event is fired after a the presort is completed for every record passed to Presort Agent.
'----------------------------------
Private Sub PresortAgent_OnGetSortedRecord(PresortID As Long, RecordID As String, nTrayID As String, nPackageID As String, DPBC As String, Endorsement As String)
On Error GoTo Error_Occurred
Dim nRecord As Long
If (PresortID = -1) Then
' No more records to receive. At this point you may want to
' sort by PresortID to display addresses in Presorted order.
'Me.Form.RecordSource = "PresortResults" 'Simple query to sort by PresortID
'Me.Form.Refresh
Else
nRecord = RecordID - 1
Me.Form.RecordsetClone.MoveFirst
Me.Form.RecordsetClone.Move nRecord
With Me.Form.RecordsetClone
.Edit
![PresortID] = PresortID
![TrayID] = GetString(nTrayID, True)
![PackageID] = GetString(nPackageID, True)
![EndorsementLine] = GetString(Endorsement, True)
![DPBarcode] = GetString(DPBC, True)
.Update
End With
End If
Exit_OnGetSortedRecord:
Exit Sub
Error_Occurred:
MsgBox Err.Description
Resume Exit_OnGetSortedRecord
End Sub
Private Sub GetLabelInfoFields(RecSet As Recordset, LabelFields() As String)
On Error Resume Next
With RecSet
LabelFields(1) = GetString(![FirstName], False)
LabelFields(2) = GetString(![LastName], False)
LabelFields(3) = GetString(![Business], False)
LabelFields(4) = GetString(![AddressLine2], False)
LabelFields(5) = GetString(![AddressLine1], False)
LabelFields(6) = ""
LabelFields(7) = ""
LabelFields(8) = ""
LabelFields(9) = ""
LabelFields(10) = ""
LabelFields(11) = ""
LabelFields(12) = ""
End With
End Sub
Private Sub GetLabelFieldNames(FieldNames() As String)
On Error Resume Next
FieldNames(1) = "FirstName"
FieldNames(2) = "LastName"
FieldNames(3) = "Business"
FieldNames(4) = "AddressLine2"
FieldNames(5) = "AddressLine1"
FieldNames(6) = ""
FieldNames(7) = ""
FieldNames(8) = ""
FieldNames(9) = ""
FieldNames(10) = ""
FieldNames(11) = ""
FieldNames(12) = ""
End Sub
Private Sub GetPresortFields(RecSet As Recordset, szCity As String, szState As String, szZip As String, szCarRt As String, szLOTNum As String, szDPC As String, szWS As String)
With RecSet
.Edit
![PresortID] = -1
![TrayID] = -1
![PackageID] = -1
![EndorsementLine] = Null
![DPBarcode] = Null
.Update
szCity = GetString(![City], False)
szState = GetString(![State], False)
szZip = GetString(![ZipCode], False)
szCarRt = GetString(![CarRT], False)
szLOTNum = GetString(![LotNum], False)
szDPC = GetString(![DPC], False)
szWS = GetString(![WalkSequence], False)
End With
End Sub
'----------------------------------
' Function: Event Handler for Presort Agent button.
' Purpose: This event is fired every time the user clicks on the Presort Agent button. It will
' also be called if you explicitly call PresortAgent.DoClick()
'----------------------------------
Public Sub PresortAgent_Click()
Dim szName As String, aFlds(12) As String
Dim szIdx As String, szCity As String, szState As String, szZip As String, szCarRt As String, szLOTNum As String, szDPC As String, szWS As String
Dim nSortOption As Integer
Dim nRecords As Long, nIdx As Long, nResult As Long
Dim SortRecSet As Recordset
' Save current record
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
On Error GoTo Error_Occurred
Set SortRecSet = Me.Form.RecordsetClone
''''' Get number of records in recordset
SortRecSet.MoveLast
SortRecSet.MoveFirst
nRecords = SortRecSet.RecordCount
''''' Preprocessing info
szName = Me.FormName
nSortOption = -1 'tkPresortLetUserChoose
nResult = PresortAgent.BeginPresortProcessing(szName, nRecords, nSortOption)
If (nResult >= 0) And (SortRecSet.Updatable) Then
GetLabelFieldNames aFlds
PresortAgent.SetLabelFieldNames aFlds(1), aFlds(2), aFlds(3), aFlds(4), aFlds(5), aFlds(6), aFlds(7), aFlds(8), aFlds(9), aFlds(10), aFlds(11), aFlds(12)
For nIdx = 1 To nRecords
GetLabelInfoFields SortRecSet, aFlds
nResult = PresortAgent.AddLabelFields(aFlds(1), aFlds(2), aFlds(3), aFlds(4), aFlds(5), aFlds(6), aFlds(7), aFlds(8), aFlds(9), aFlds(10), aFlds(11), aFlds(12))
If (nResult >= 0) Then
szIdx = nIdx
GetPresortFields SortRecSet, szCity, szState, szZip, szCarRt, szLOTNum, szDPC, szWS
nResult = PresortAgent.AddToMailingList(szIdx, szCity, szState, szZip, szCarRt, szLOTNum, szDPC, szWS)
End If
If (nResult < 0) Then
GoTo Exit_CertificationSub
End If
SortRecSet.MoveNext
Next nIdx
End If
SortRecSet.MoveFirst
Exit_CertificationSub:
Exit Sub
Error_Occurred:
If (Err.Description <> "") Then
MsgBox Err.Description
End If
Resume Exit_CertificationSub
End Sub
'----------------------------------
' Function: Event Handler for ZipAgent button.
' Purpose: This event is fired every time the user clicks on the Zip Agent button. It will
' also be called if you explicitly call ZipAgent.DoClick()
' Notes: This function gets an address from the current form (not the recordset),
' call CertifyAddress, and saves changes back to current form.
'----------------------------------
Public Sub ZipAgent_Click()
Dim szBusiness As String, szAddressLine2 As String, szAddressLine1 As String, szCity As String, szState As String, szZip As String, szCarRt As String, szLOTNum As String, szDPC As String
Dim nErrorCodes As Long, nCASSDate As Long, szCountyName As String, nCountyCode As Long
' Get address from active form.
szBusiness = GetString([Business], False)
szAddressLine2 = GetString([AddressLine2], False)
szAddressLine1 = GetString([AddressLine1], False)
szCity = GetString([City], False)
szState = GetString([STATE_AREA], False)
szZip = GetString([ZipCode], False)
szCarRt = GetString([CarRT], False)
szLOTNum = GetString([LotNum], False)
szDPC = GetString([DPC], False)
nCASSDate = 0
nErrorCodes = 0
' Certify it.
ZipAgent.CertifyAddress szBusiness, szAddressLine2, szAddressLine1, szCity, szState, szZip, szCarRt, szLOTNum, szDPC, nErrorCodes, nCASSDate
' Refresh form with new data.
[Business] = GetString(szBusiness, True)
[AddressLine2] = GetString(szAddressLine2, True)
[AddressLine1] = GetString(szAddressLine1, True)
[City] = GetString(szCity, True)
[STATE_AREA] = GetString(szState, True)
[ZipCode] = GetString(szZip, True)
[CarRT] = GetString(szCarRt, True)
[LotNum] = GetString(szLOTNum, True)
[DPC] = GetString(szDPC, True)
[CASSDate] = nCASSDate
[ErrorCodes] = nErrorCodes
End Sub
Last edited: