MS Access Database Runtime Error 2137

resqtech

New Member

Join Date: Dec 2009
Posts: 1

MS Access Database Runtime Error 2137

Dec 24 '09, 07:02 AM

I am having an issue with an Access Database that worked at one time and after a Windows Update that screwed up the profile it stopped working. The following is what VB is stating causes the error. Any help would be greatly appreciated.

Code:

DoCmd.FindRecord c, acEntire, True, acSearchAll, True, acCurrent, True

This is part of another group:

Code:

Private Sub name_Change()
Dim c As String
c = Me!name
DoCmd.GoToControl "ACCOUNT"
DoCmd.FindRecord c, acEntire, True, acSearchAll, True, acCurrent, True
DoCmd.GoToControl "FIRST NAME"
End Sub

Which is part of a whole group:

Option Compare Database
Option Explicit

Private Sub ADDRESS_Exit(Cancel As Integer)
Me.Refresh
End Sub

Private Sub CITY_Exit(Cancel As Integer)
Me.Refresh
End Sub

Private Sub Combo56_Change()
Dim db As Database, cr As Recordset, a
Set db = CurrentDb()
Me.Refresh
a = Me!Combo56
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT [INSTRUMENT RENTAL].[INST TYPE] INTO USYSTYPE FROM [INSTRUMENT RENTAL]WHERE ((([INSTRUMENT RENTAL].[INST TYPE])=[FORMS]![INSTRUMENT RENTAL]![combo56]));"
DoCmd.SetWarnings True
Set cr = db.OpenRecordset("USYSTYPE", dbOpenDynaset)
If Not cr.EOF Then
cr.MoveLast
Me![TOTALS] = a & "S RENTED = " & cr.RecordCount
Else
Me![TOTALS] = a & "S RENTED = 0"
End If
Me!TOTALS.Visible = True
cr.Close
End Sub

Private Sub Command36_Click()
On Error GoTo Err_Command36_Click


    DoCmd.GoToRecord , , acFirst

Exit_Command36_Click:
    Exit Sub

Err_Command36_Click:
    MsgBox Err.Description
    Resume Exit_Command36_Click
    
End Sub
Private Sub Command37_Click()
On Error GoTo Err_Command37_Click


    DoCmd.GoToRecord , , acLast

Exit_Command37_Click:
    Exit Sub

Err_Command37_Click:
    MsgBox Err.Description
    Resume Exit_Command37_Click
    
End Sub
Private Sub Command38_Click()
On Error GoTo Err_Command38_Click


    DoCmd.GoToRecord , , acNext

Exit_Command38_Click:
    Exit Sub

Err_Command38_Click:
    MsgBox Err.Description
    Resume Exit_Command38_Click
    
End Sub
Private Sub Command39_Click()
On Error GoTo Err_Command39_Click


    DoCmd.GoToRecord , , acPrevious

Exit_Command39_Click:
    Exit Sub

Err_Command39_Click:
    MsgBox Err.Description
    Resume Exit_Command39_Click
    
End Sub
Private Sub Command40_Click()
On Error GoTo Err_Command40_Click


    Screen.PreviousControl.SetFocus
    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

Exit_Command40_Click:
    Exit Sub

Err_Command40_Click:
    MsgBox Err.Description
    Resume Exit_Command40_Click
    
End Sub
Private Sub Command41_Click()
On Error GoTo Err_Command41_Click


    DoCmd.GoToRecord , , acNewRec

Exit_Command41_Click:
    Exit Sub

Err_Command41_Click:
    MsgBox Err.Description
    Resume Exit_Command41_Click
   DoCmd.GoToControl "FIRST NAME"
End Sub
Private Sub Command42_Click()
On Error GoTo Err_Command42_Click


    DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
    DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

Exit_Command42_Click:
    Exit Sub

Err_Command42_Click:
    MsgBox Err.Description
    Resume Exit_Command42_Click
    
End Sub
Private Sub Command43_Click()
On Error GoTo Err_Command43_Click


    DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

Exit_Command43_Click:
    Exit Sub

Err_Command43_Click:
    MsgBox Err.Description
    Resume Exit_Command43_Click
    
End Sub
Private Sub Command44_Click()
On Error GoTo Err_Command44_Click


    DoCmd.Close

Exit_Command44_Click:
    Exit Sub

Err_Command44_Click:
    MsgBox Err.Description
    Resume Exit_Command44_Click
    
End Sub

Private Sub Command46_Click()
Dim c As String
Me.Refresh
c = MsgBox("ARE YOU SURE YOU WANT TO PRINT ALL THE INVOICES?", vbYesNo + vbQuestion + vbDefaultButton2, "PRINT INVOICES")
If c = 6 Then
DoCmd.OpenReport "InstRenInv1", acViewPreview
DoCmd.OpenReport "InstRenInv2", acViewPreview
End If
End Sub

Private Sub Command47_Click()
Me.Refresh
DoCmd.OpenReport "InstRenSinInv", acViewPreview
End Sub

Private Sub Command51_Click()
DoCmd.Quit acQuitPrompt
End Sub

Private Sub Command52_Click()
Dim db As Database, cr As Recordset, a
Set db = CurrentDb()
Me!TOTALS.Visible = False
a = InputBox$("ENTER THE TYPE OF INSTRUMENT!", "INSTRUMENT TYPE")
If a = "" Then
GoTo FIN
End If
Me!HID = a
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT [INSTRUMENT RENTAL].[INST TYPE] INTO USYSTYPE FROM [INSTRUMENT RENTAL]WHERE ((([INSTRUMENT RENTAL].[INST TYPE])=[FORMS]![INSTRUMENT RENTAL]![HID]));"
DoCmd.SetWarnings True
Set cr = db.OpenRecordset("USYSTYPE", dbOpenDynaset)
If Not cr.EOF Then
cr.MoveLast
Me![TOTALS] = a & "S RENTED = " & cr.RecordCount
Else
Me![TOTALS] = a & "S RENTED = 0"
End If
Me!TOTALS.Visible = True
cr.Close
GoTo FIN1
FIN:
MsgBox "YOU DID NOT ENTER AN INSTRUMENT TYPE!"
FIN1:
End Sub

Private Sub Command58_Click()
DoCmd.OpenReport "InstTable", acViewPreview
End Sub

Private Sub Command59_Click()
DoCmd.OpenReport "PastDue", acViewPreview
End Sub

Private Sub FIRST_NAME_Exit(Cancel As Integer)
Me.Refresh
End Sub

Private Sub Form_Activate()
DoCmd.Maximize
End Sub

Private Sub Form_Load()
Dim db As Database, cr As Recordset, a As Integer
Set db = CurrentDb()
Set cr = db.OpenRecordset("SELECT [INSTRUMENT RENTAL].[FIRST NAME], [INSTRUMENT RENTAL].[LAST NAME], [INSTRUMENT RENTAL].ADDRESS, [INSTRUMENT RENTAL].[MAILING ADDRESS], [INSTRUMENT RENTAL].CITY, [INSTRUMENT RENTAL].STATE, [INSTRUMENT RENTAL].ZIP, [INSTRUMENT RENTAL].[HOME PHONE], [INSTRUMENT RENTAL].[WORK PHONE], [INSTRUMENT RENTAL].[INST TYPE], [INSTRUMENT RENTAL].[INST MFR], [INSTRUMENT RENTAL].[SERIAL NO], [INSTRUMENT RENTAL].[PURCHASE PRICE], [INSTRUMENT RENTAL].[PURCHASE BALANCE], [INSTRUMENT RENTAL].[RENTAL FEE], [INSTRUMENT RENTAL].[LATE FEE], [INSTRUMENT RENTAL].[OVERDUE PMT], [INSTRUMENT RENTAL].ACCOUNT FROM [INSTRUMENT RENTAL]WHERE ((([INSTRUMENT RENTAL].[OVERDUE PMT])>0));", dbOpenDynaset)
If Not cr.EOF Then
cr.MoveLast
a = cr.RecordCount
MsgBox "THERE ARE " & "(" & a & ")" & " CUSTOMERS WHO HAVE PAST DUE BALANCES! PRESS THE PAST DUE BALANCES OPTION BUTTON TO VIEW THEM!"
End If
End Sub

Private Sub INST_TYPE_Exit(Cancel As Integer)
Me.Refresh
End Sub

Private Sub LAST_NAME_Exit(Cancel As Integer)
Me.Refresh
End Sub

Private Sub MAILING_ADDRESS_Exit(Cancel As Integer)
Me.Refresh
End Sub

Private Sub name_Change()
Dim c As String
c = Me!name
DoCmd.GoToControl "ACCOUNT"
DoCmd.FindRecord c, acEntire, True, acSearchAll, True, acCurrent, True
DoCmd.GoToControl "FIRST NAME"
End Sub

Private Sub Option60_Click()
Dim db As Database, cr As Recordset, a As Integer
Set db = CurrentDb()
Set cr = db.OpenRecordset("SELECT [INSTRUMENT RENTAL].[FIRST NAME], [INSTRUMENT RENTAL].[LAST NAME], [INSTRUMENT RENTAL].ADDRESS, [INSTRUMENT RENTAL].[MAILING ADDRESS], [INSTRUMENT RENTAL].CITY, [INSTRUMENT RENTAL].STATE, [INSTRUMENT RENTAL].ZIP, [INSTRUMENT RENTAL].[HOME PHONE], [INSTRUMENT RENTAL].[WORK PHONE], [INSTRUMENT RENTAL].[INST TYPE], [INSTRUMENT RENTAL].[INST MFR], [INSTRUMENT RENTAL].[SERIAL NO], [INSTRUMENT RENTAL].[PURCHASE PRICE], [INSTRUMENT RENTAL].[PURCHASE BALANCE], [INSTRUMENT RENTAL].[RENTAL FEE], [INSTRUMENT RENTAL].[LATE FEE], [INSTRUMENT RENTAL].[OVERDUE PMT], [INSTRUMENT RENTAL].ACCOUNT FROM [INSTRUMENT RENTAL]WHERE ((([INSTRUMENT RENTAL].[OVERDUE PMT])>0));", dbOpenDynaset)
Me.RecordSource = "SELECT [INSTRUMENT RENTAL].[FIRST NAME], [INSTRUMENT RENTAL].[LAST NAME], [INSTRUMENT RENTAL].ADDRESS, [INSTRUMENT RENTAL].[MAILING ADDRESS], [INSTRUMENT RENTAL].CITY, [INSTRUMENT RENTAL].STATE, [INSTRUMENT RENTAL].ZIP, [INSTRUMENT RENTAL].[HOME PHONE], [INSTRUMENT RENTAL].[WORK PHONE], [INSTRUMENT RENTAL].[INST TYPE], [INSTRUMENT RENTAL].[INST MFR], [INSTRUMENT RENTAL].[SERIAL NO], [INSTRUMENT RENTAL].[PURCHASE PRICE], [INSTRUMENT RENTAL].[PURCHASE BALANCE], [INSTRUMENT RENTAL].[RENTAL FEE], [INSTRUMENT RENTAL].[LATE FEE], [INSTRUMENT RENTAL].[OVERDUE PMT], [INSTRUMENT RENTAL].ACCOUNT FROM [INSTRUMENT RENTAL]WHERE ((([INSTRUMENT RENTAL].[OVERDUE PMT])>0));"
Forms![INSTRUMENT RENTAL]![name].RowSource = "SELECT [INSTRUMENT RENTAL].ACCOUNT,[INSTRUMENT RENTAL].[LAST NAME], [INSTRUMENT RENTAL].[FIRST NAME], [INSTRUMENT RENTAL].ADDRESS, [INSTRUMENT RENTAL].[HOME PHONE]FROM [INSTRUMENT RENTAL]WHERE ((([INSTRUMENT RENTAL].[OVERDUE PMT]) > 0))ORDER BY [INSTRUMENT RENTAL].[LAST NAME];"
Me.Requery
If Not cr.EOF Then
cr.MoveLast
a = cr.RecordCount
MsgBox "THE FOLLOWING " & "(" & a & ")" & " CUSTOMERS HAVE PAST DUE BALANCES!"
Forms![INSTRUMENT RENTAL]![PAST DUE BALANCE].ForeColor = 255
Else
Me.RecordSource = "SELECT [INSTRUMENT RENTAL].* FROM [INSTRUMENT RENTAL]ORDER BY [INSTRUMENT RENTAL].[LAST NAME];"
Forms![INSTRUMENT RENTAL]![name].RowSource = "SELECT [INSTRUMENT RENTAL].ACCOUNT,[INSTRUMENT RENTAL].[LAST NAME], [INSTRUMENT RENTAL].[FIRST NAME], [INSTRUMENT RENTAL].ADDRESS, [INSTRUMENT RENTAL].[HOME PHONE] FROM [INSTRUMENT RENTAL] ORDER BY [INSTRUMENT RENTAL].[LAST NAME];"
Forms![INSTRUMENT RENTAL]![PAST DUE BALANCE].ForeColor = 0
Me.Requery
MsgBox "THE ARE NO CUSTOMERS WHO HAVE PAST DUE BALANCES!"
End If
End Sub

Private Sub Option65_Click()
Me.RecordSource = "SELECT [INSTRUMENT RENTAL].* FROM [INSTRUMENT RENTAL]ORDER BY [INSTRUMENT RENTAL].[LAST NAME];"
Forms![INSTRUMENT RENTAL]![name].RowSource = "SELECT [INSTRUMENT RENTAL].ACCOUNT,[INSTRUMENT RENTAL].[LAST NAME], [INSTRUMENT RENTAL].[FIRST NAME], [INSTRUMENT RENTAL].ADDRESS, [INSTRUMENT RENTAL].[HOME PHONE] FROM [INSTRUMENT RENTAL] ORDER BY [INSTRUMENT RENTAL].[LAST NAME];"
Forms![INSTRUMENT RENTAL]![PAST DUE BALANCE].ForeColor = 0
Me.Requery
End Sub

Private Sub STATE_Exit(Cancel As Integer)
Me.Refresh
End Sub

Private Sub ZIP_Exit(Cancel As Integer)
Me.Refresh
End Sub

Last edited by debasisdas; Dec 24 '09, 08:54 AM. Reason: Formatted suing code tags.

Tags: None

debasisdas

Recognized Expert Expert

Join Date: Dec 2006

Posts: 8119
#2

Dec 24 '09, 08:55 AM

Kindly mention which block of code is causing the error.also mention the error number and error message.
Comment

Previous template Next

MS Access Database Runtime Error 2137

MS Access Database Runtime Error 2137

Comment