[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