[AccessD] Error #: 3709 "The search key was not found in any record"
Robert
robert at servicexp.com
Mon Jul 13 19:22:45 CDT 2015
Ok so I'm at my wits-end here; for some reason I have a customer that is intermittently getting the above error.
1) There is no corrupted records, I can add and or delete records, I can delete all records, etc.
2) There are no primary keys on memo fields.
3) I can compact and repair both back end db's with no problem
4) I have run both db's through JetCOMP.
I simply cannot find any problems with the data or structure of these databases.
MS Access 2007 .mde front end
Ms Access 2002 .mdb back end (both) One is secured and the other is not.
Here is the code (I know it's not very efficient but...:-) ) that is generating the error maybe 2 to 3 times a day. (this function is called every 5-10 minutes during a 10 hour day)
***********************************************************************************************
'---------------------------------------------------------------------------------------
'. Procedure : SyncroniseEventTbl
'. DateTime : 11/15/2006 19:57
'. Author : Robert
'. Revision :
' Purpose : Synchronize The ServiceCall Table and The Event Table (2 different db's)
'---------------------------------------------------------------------------------------
'
Public Function SyncroniseEventTbl() As Boolean
Dim db As DAO.Database
Dim rstSCTbl As DAO.Recordset
Dim rstEvents As DAO.Recordset
Dim lRN As Long
Dim dOldDate As Date
Dim dNewDate As Date
Dim dSchTimeStart As Date
Dim dSchTimeEnd As Date
'Let do a quick orphan kill run before we start
10 On Error GoTo HandleErr
20 DeleteScheduleEventOrphan
30 Set db = CurrentDb
40 Set rstSCTbl = db.OpenRecordset("qryselShedulerViewCal", dbOpenForwardOnly)
50 Set rstZones = db.OpenRecordset("qrySelZones", dbOpenDynaset)
60 Set rstEvents = db.OpenRecordset("Event", dbOpenDynaset)
''Debug.Print "Syncing Tbls"
70 PMIncrement 1, "Opening and Retrieving Schedule data ..."
80 With rstSCTbl
90 If .RecordCount > 0 Then
100 DoEvents
110 Do Until .EOF
120 PMIncrement 1, "Opening and Retrieving Schedule data ..."
130 CalendarLocked = False
140 rstEvents.FindFirst "RepairNumber= " & CLng(!RepairNumber)
150 If rstEvents.NoMatch = True Then 'Lets add the event to the table
160 If IsNull(!DateScheduled) = True Then 'We don't want to add any none scheduled items
GoTo MoveHere:
170 End If
180 rstEvents.AddNew
190 rstEvents!ScheduleID = MatchScheduleID(!PreferredName)
200 rstEvents!StartDateTime = DateFromString(!DateScheduled, Nz(!TimeScheduledIn, TimeValue(Now()))) 'dSchTimeStart
210 rstEvents!EndDateTime = DateFromString(!DateScheduled, Nz(!TimeScheduledout, TimeValue(Now()))) 'dSchTimeEnd
220 rstEvents!Subject = GetHeader(rstSCTbl)
230 rstEvents!Location = !Address & "; " & !City & "; Contact # " & Format(!CPhone, "@@@-@@@-@@@@")
240 rstEvents!Body = Left(!CustomerComplaints, 254)
250 rstEvents!Created = Now
260 rstEvents!BusyStatus = Nz(!EventBusyStatus, 2)
270 rstEvents!ImportanceLevel = Nz(!EventImportanceLevel, 2)
280 rstEvents!CustomPropertiesXMLData = ""
290 rstEvents!ReminderMinutesBeforeStart = 15
300 rstEvents!RemainderSoundFile = ""
310 rstEvents!RepairNumber = !RepairNumber
320 rstEvents.Update
330 Else ' We will Synchronize below
'Make sure we delete any unscheduled work orders
340 If IsNull(!DateScheduled) = True Then
350 rstEvents.Delete
GoTo MoveHere:
360 End If
370 rstEvents.Edit
380 If CalendarSyncTech = True Then
390 rstEvents!ScheduleID = MatchScheduleID(!PreferredName)
400 End If
'added 07/08/08
'Need to check for any discrepancies between graphic schedule date and system date
410 If DateValue(rstEvents!StartDateTime) <> DateValue(!DateScheduled) Then
420 dOldDate = DateValue(rstEvents!StartDateTime)
430 rstEvents!StartDateTime = DateFromString(!DateScheduled, TimeValue(rstEvents!StartDateTime))
440 dNewDate = DateValue(!DateScheduled)
450 rstEvents!EndDateTime = DateFromString(!DateScheduled, TimeValue(rstEvents!EndDateTime))
460 WriteSysNotes !RepairNumber, " Auto Schedule Sync. System: From " & dOldDate & " To: " & dNewDate, , True
470 End If
480 If m_bCalendarSyncTimes = True Then
490 rstEvents!StartDateTime = DateFromString(!DateScheduled, !TimeScheduledIn)
500 rstEvents!EndDateTime = DateFromString(!DateScheduled, !TimeScheduledout)
510 End If
520 If CalendarUpdateHeaderInfo = True Then
530 rstEvents!Subject = GetHeader(rstSCTbl)
540 End If
550 rstEvents!Location = !Address & "; " & !City & "; Contact # " & Format(!CPhone, "@@@-@@@-@@@@")
560 rstEvents!Modified = Now
570 rstEvents!ImportanceLevel = Nz(!EventImportanceLevel, 2)
580 rstEvents!ReminderMinutesBeforeStart = 15
590 rstEvents!RemainderSoundFile = ""
600 rstEvents.Update
MoveHere:
610 End If
620 .MoveNext
' DoEvents 'This was slowing down the above code BIG TIME 11/05/11
630 Loop
640 End If
650 End With
'Let do a quick orphan kill run again
660 DeleteScheduleEventOrphan
670 PMIncrement 1, "Opening and Retrieving Schedule data ... Complete"
680 PM True
ExitHere:
690 On Error Resume Next
700 rstSCTbl.Close
710 Set rstSCTbl = Nothing
720 rstEvents.Close
730 Set rstEvents = Nothing
740 rstZones.Close
750 Set rstZones = Nothing
760 db.Close
770 Set db = Nothing
780 Exit Function
HandleErr:
790 Select Case Err.Number
Case 3167, 94 ' A record was deleted and Null value found
800 Resume Next
810 Case 3218, 3624, 3197, 3260, 3187
820 frm.Caption = "Schedule Navigator..." & " Last Graphic Refresh On: " & Now & " Failed : A User Has Records Locked, Please Wait "
830 CalendarLocked = True
840 SendGlobalRefresh
850 Case 3420, 3021, 91
860 MsgBox "Sorry, The Graphic Calendar System has encountered a problem, and must close.", , "Error: " & Err.Number
870 rstSCTbl.Close
880 Set rstSCTbl = Nothing
890 rstEvents.Close
900 Set rstEvents = Nothing
910 rstZones.Close
920 Set rstZones = Nothing
930 db.Close
940 Set db = Nothing
950 frm.Err.Raise 159753 'This causes a Application-defined or object-defined error that moves to the starting proc
960 CloseScheduleAndReOpen
970 Case -2147352567 ' Deleted record
980 Resume Next
990 Case Else
'MsgBox Err.BuildError("clsCalendar:SyncroniseEventTbl"), vbCritical, "Un-Expected Error"
1000 MsgBox "There has been an error in Procedure: clsCalendar:SyncroniseEventTbl " & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description & " On Line: " & Erl() & vbCrLf & _
" Please Contact " & "The SoftwareVendor" & " for more help regarding this error. ", vbCritical, "Un-Expected Error"
1010 Call ErrorRecordSystem(Err.Number, Err.Description & " On Line: " & Erl(), Now, "Un-Expected Error In Proc; " & "clsCalendar:SyncroniseEventTbl", CurrentUser, Err)
1020 Resume ExitHere
1030 End Select
End Function
**************************************************************************************************
More information about the AccessD
mailing list