Need help with Run-Time error '2021' Access Database 1

[chunkII123]

I am not a programmer, however I am a IT professional specializing in computer hardware diagnostics, and networking. I recently went to work for a company in Grand Rapids, MI and we seem to have a problem with our time clock portion of the data base, I have included thewhole timeclock database via Visual Studio Debugger. Any help is much appreciated. The error occurs at the .edit function on line '146'. thanks again.

Option Compare Database

Private Sub Form_Load()

Call Load_List

End Sub

Private Sub Clear_List()

Dim Count As Integer

Count = TimeInListBox.ListCount

If Not (Count = 0) Then
Do While Count > 0
TimeInListBox.RemoveItem (Count - 1)
Count = Count - 1
Loop
End If

End Sub

Private Sub TimeClockManageButton_Click()

DoCmd.OpenForm "EnterPassword", , , stLinkCriteria

End Sub

Private Sub TimeInOutButton_Click()

Dim AB As Database, employeeRS As Recordset, EmpNum As String

EmpNum = InputBox("Enter Employee Number: ", "Employee Number")

If Len(EmpNum) > 0 Then

Set AB = OpenDatabase("C:\Access DB\MMI.mdb")

Set employeeRS = AB.OpenRecordset("Select * From Employees " _
& "Where EmployeeNumber = " & EmpNum & ";", dbOpenDynaset)

If employeeRS.EOF Then
MsgBox "Employee Number Not Valid"
Else
If employeeRS!Status = "out" Then
Call Add_Record(EmpNum)
TimeMessageTextBox.value = employeeRS!firstname & " IN at " & Format(Time, "Medium Time")
Else
Call Edit_Record(EmpNum)
TimeMessageTextBox.value = employeeRS!firstname & " OUT at " & Format(Time, "Medium Time")
End If
End If

employeeRS.Close
AB.Close

End If

Call Load_List

End Sub

Public Sub Load_List()

Call Clear_List

Dim AB As Database, employeeRS As Recordset

Set AB = OpenDatabase("C:\Access DB\MMI.mdb")

Set employeeRS = AB.OpenRecordset("Select * From Employees " _
& "Where Employees.Status = 'in'; ", dbOpenDynaset)

Do While Not employeeRS.EOF
TimeInListBox.AddItem (employeeRS!firstname)
employeeRS.MoveNext
Loop

employeeRS.Close
AB.Close

End Sub

Public Function Get_Total(StartTime, EndTime) As Double

Dim TotalMinutes, SHour, EHour, SMinute, EMinute

SHour = Hour(StartTime)
EHour = Hour(EndTime)
SMinute = Minute(StartTime)
EMinute = Minute(EndTime)

If EHour > SHour Then
TotalMinutes = ((EHour - (SHour + 1)) * 60) + (EMinute + (60 - SMinute))
ElseIf EHour = SHour Then
TotalMinutes = EMinute - SMinute
Else
TotalMinutes = ((EHour + (23 - SHour)) * 60) + (EMinute + (60 - SMinute))
End If

Get_Total = TotalMinutes / 60

End Function

Private Sub Add_Record(EmpNum)

Dim AB As Database, TimesheetRS As Recordset, employeeRS As Recordset, id As String

Set AB = OpenDatabase("C:\Access DB\MMI.mdb")
Set employeeRS = AB.OpenRecordset("Select * From Employees " _
& "Where EmployeeNumber = " & EmpNum & ";", dbOpenDynaset)
Set TimesheetRS = AB.OpenRecordset("Timesheet", dbOpenDynaset)

With TimesheetRS
.AddNew
!EmployeeNumber = employeeRS!EmployeeNumber
!first = employeeRS!firstname
!last = employeeRS!lastname
!Start = Time
!total = 0
!Date = Date
.Update
End With

TimesheetRS.MoveLast

With employeeRS
.Edit
!Status = "in"
!RecordID = TimesheetRS!RecordID
.Update
End With

employeeRS.Close
TimesheetRS.Close
AB.Close

End Sub

Private Sub Edit_Record(EmpNum)

Dim AB As Database, TimesheetRS As Recordset, employeeRS As Recordset, id As String

Set AB = OpenDatabase("C:\Access DB\MMI.mdb")
Set employeeRS = AB.OpenRecordset("Select * From Employees " _
& "Where EmployeeNumber = " & EmpNum & ";", dbOpenDynaset)
id = employeeRS!RecordID

Set TimesheetRS = AB.OpenRecordset("Select * From Timesheet " _
& "Where RecordID = " & id & ";", dbOpenDynaset)

With TimesheetRS
.Edit
!End = Time
!total = Get_Total(!Start, Time)
.Update
End With

With employeeRS
.Edit
!Status = "out"
!RecordID = 0
.Update
End With

employeeRS.Close
TimesheetRS.Close
AB.Close

End Sub

Private Sub TimeInOutButton_Exit(Cancel As Integer)

Exit Sub

End Sub

Private Sub TimeTodayButton_Click()

Dim AB As Database, TimesheetRS As Recordset, employeeRS As Recordset
Dim TotalHours, EmpNum As String, Name As String, SDate

TotalHours = 0
SDate = Format(Date, "Short Date")

Set AB = OpenDatabase("C:\Access DB\MMI.mdb")

EmpNum = InputBox("Enter Employee Number: ", "Employee Number")

Set employeeRS = AB.OpenRecordset("Select * From Employees " _
& "Where EmployeeNumber = " & EmpNum & ";", dbOpenDynaset)
Set TimesheetRS = AB.OpenRecordset("Select * From TimeSheet " _
& "Where EmployeeNumber = " & EmpNum & " And Date = #" _
& SDate & "#;", dbOpenDynaset)

If employeeRS.EOF Then
MsgBox "Employee Number Not Valid"
Else
Do While Not TimesheetRS.EOF
With TimesheetRS
TotalHours = TotalHours + TimesheetRS!total
Name = TimesheetRS!first
.MoveNext
End With
Loop
End If

employeeRS.Close
TimesheetRS.Close
AB.Close

TimeMessageTextBox.value = Name & "'s Total Today is " & Format(TotalHours, "Fixed")

End Sub

Private Sub TimeWeekButton_Click()

Dim AB As Database, TimesheetRS As Recordset, employeeRS As Recordset
Dim TotalHours, EmpNum As String, Name As String, DayNum, SDate, Lookup

TotalHours = 0
DayNum = 0
SDate = Format(Date, "Short Date")

DayNum = Weekday(Date)
Select Case DayNum
Case 1
Lookup = DateSerial(Year(Date), Month(Date), (Day(Date)) - 6)
Case 2
Lookup = DateSerial(Year(Date), Month(Date), Day(Date))
Case 3
Lookup = DateSerial(Year(Date), Month(Date), (Day(Date)) - 1)
Case 4
Lookup = DateSerial(Year(Date), Month(Date), (Day(Date)) - 2)
Case 5
Lookup = DateSerial(Year(Date), Month(Date), (Day(Date)) - 3)
Case 6
Lookup = DateSerial(Year(Date), Month(Date), (Day(Date)) - 4)
Case Else
Lookup = DateSerial(Year(Date), Month(Date), (Day(Date)) - 5)
End Select

Set AB = OpenDatabase("C:\Access DB\MMI.mdb")

EmpNum = InputBox("Enter Employee Number: ", "Employee Number")

Set employeeRS = AB.OpenRecordset("Select * From Employees " _
& "Where EmployeeNumber = " & EmpNum & ";", dbOpenDynaset)
Set TimesheetRS = AB.OpenRecordset("Select * From TimeSheet " _
& "Where EmployeeNumber = " & EmpNum & " And Date Between #" _
& SDate & "# And #" & Lookup & "#;", dbOpenDynaset)

If employeeRS.EOF Then
MsgBox "Employee Number Not Valid"
Else
Do While Not TimesheetRS.EOF
With TimesheetRS
TotalHours = TotalHours + TimesheetRS!total
Name = TimesheetRS!first
.MoveNext
End With
Loop
End If

employeeRS.Close
TimesheetRS.Close
AB.Close

TimeMessageTextBox.value = Name & "'s Total This Week is " & Format(TotalHours, "Fixed")

End Sub

 

[dhookom]

There are lots of .edit in the code so it would help if you noted which one was line 146.

Also, I would change the Dim statements to be more explicit

Dim AB As DAO.Database, TimesheetRS As DAO.Recordset, employeeRS As DAO.Recordset

IMO, it is better to name the fields rather than using "SELECT *".

Duane
Hook'D on Access
MS Access MVP

 

[chunkII123]

again, Iam not the original programmer of this VB sheet, to bemore specific it is the .edit line at

Private Sub Edit_Record(EmpNum)

Dim AB As Database, TimesheetRS As Recordset, employeeRS As Recordset, id As String

Set AB = OpenDatabase("C:\Access DB\MMI.mdb")
Set employeeRS = AB.OpenRecordset("Select * From Employees " _
& "Where EmployeeNumber = " & EmpNum & ";", dbOpenDynaset)
id = employeeRS!RecordID

Set TimesheetRS = AB.OpenRecordset("Select * From Timesheet " _
& "Where RecordID = " & id & ";", dbOpenDynaset)

With TimesheetRS
.Edit
!End = Time
!total = Get_Total(!Start, Time)
.Update
End With

With employeeRS
.Edit
!Status = "out"
!RecordID = 0
.Update
End With

employeeRS.Close
TimesheetRS.Close
AB.Close

End Sub

it is the first .edit line within that section of the program that is causing the program to fault out on employee number 107. Thanks again

 

[vbajock]

Dude, give us a clue - what is the error message you are receiving?

 

[chunkII123]

dude, check the title of the post.

 

[vbajock]

Dude, those numbers could mean a number of different things, what is the text message you are receiving with it?

 

[dhookom]

The error number doesn't do us much good. I would check for the BOF or EOF prior to attempting to edit.

With TimesheetRS
  If Not (.EOF AND .BOF) Then
    Debug.Print !Start
    .Edit
      !End = Time
      !total = Get_Total(!Start, Time)
    .Update
  End If
End With

There doesn't seem to be much error handling or integrity checking in the code.

Duane
Hook'D on Access
MS Access MVP

 

[vbajock]

My guess is your table has no data in it, your code has no way of handling that possibility, so it would blow up if it encountered it, whoever wrote the code is a twit.

 

[chunkII123]

VBAJOCK:

there seems to be a new error that has got ourwhole company perplexed, maybe if we can fix that one we can move on and fix the original problem. After lunch today someone went to sign into the time clock and it started giving the 'error 91', when I run the debug it says there is an error in this line:

"If Len(EmpNum) > 0 Then
Set employeeRS = AB.OpenRecordset("Select * From Employees " _
& "Where EmployeeNumber = " & EmpNum & ";", dbOpenDynaset)"

(the quote surrounding are disregarded as part of this post)

What happens is you click the in/out button, put in your employee number, it then says 'runtime error '91' "Object Variable or With block variable not set."

in my debugger it says that it is on line 38 of the main code (from original post) can you help me with that (as of now no one, not even I can punch out)

 

[dhookom]

I expect this is a references issue. While in any module, select Tools->References and check for MISSING references. While you are there, uncheck the MS ADO reference if it is checked. Then recheck it after so the MS DAO reference is listed above the MS ADO.

Then as I suggested earlier, search through all the code and replace all:
[tt][red] " As Database" with " As DAO.Database"[/red][/tt]
and
[tt][red] " As Recordset" with " As DAO.Recordset"[/red][/tt]

You can do this with two search and replace on all modules. Then compile your code.

Duane
Hook'D on Access
MS Access MVP

 

[chunkII123]

The Tool->References worked once, but it was greyed out the followingtime after doing the replacement. Any ideas?

 

[dhookom]

It would be disabled if code was running. Are you in a break mode? Did you attempt to compile?

Duane
Hook'D on Access
MS Access MVP