Code breaking out with no warning message or anything.

R

Ronald Dodge

The below code is breaking out on the line of:

pcdFormToDrs False

I have no idea as to why this is happening, cause in the earlier tests, this
worked fine and had no such issues. VBA option is setup to break only on
unhandled errors. It only breaks out on the first person who clicks on the
"Log In" command button. When this happens, one can press "F5" to run the
program, and everything works as expected. Anyone else logging in after
this person does, even with VBA closed out, this does not break out again
and it works as expected. I have checked all of the references with VBA,
and everything is okay in there.

Private Sub cmdLogIn_Click()
Dim strMSG As String, strEmpName As String, lngRecCount As Long
Me.lblStatus.Caption = ""
OpenDRS:
On Error Resume Next
drsEMP.Requery
If err.Number <> 0 Then
modDB.pcdOpenDRS
drsEMP.Requery
End If
'GoTo OpenDRS
lngRecCount = drsEMP.RecordCount
If lngRecCount > 0 Then
drsEMP.FindFirst ("fldstrEmpID = '" & Me.tbxfldstrEmpIDUnbound.Value
& "'")
End If
If drsEMP.NoMatch Or lngRecCount = 0 Then
If MsgBox("Are you a new employee?", 52) = 6 Then
MsgBox "Please click on ""New Employee"" command button to fill
out your information on a one time basis.", 48
Exit Sub
Else
strMSG = "Please be sure to put in your employee ID value
correctly."
End If
Else
strEmpName =
modFN.fncstrPersonFullName(drsEMP.Fields("fldstrFirstName").Value,
drsEMP.Fields("fldstrLastName").Value, _
Nz(drsEMP.Fields("fldstrMiddleInit").Value, ""),
Nz(drsEMP.Fields("fldstrSuffix").Value, ""))
End If
If Me.cbxfldstrWrkCode.Value = "" Then
If strMSG <> "" Then
strMSG = strMSG & vbCrLf & "A valid work code is required to log
into a type of work."
End If
strMSG = strMSG & "A valid work code is required to log into a type
of work."
End If
If strMSG = "" Then
If MsgBox("Are you " & strEmpName & "?", 52) - 7 Then
pcdFormToDrs False
Me.lblStatus.Caption = strEmpName & " is now logged into the
work code of " & Me.cbxfldstrWrkCode.Value & "."
Else
Me.lblStatus.Caption = "Please make sure you have the correct
Employee ID entered on the screen."
Beep
End If
Else
Me.lblStatus.Caption = strMSG
Beep
End If
End Sub
Private Sub pcdFormToDrs(ByVal bolLogOut As Boolean)
Dim dblCurTime As Date, lngRecCount As Long
dblCurTime = Now
Me.lblStatus.Caption = ""
drsHrsCur.Requery
lngRecCount = drsHrsCur.RecordCount
If lngRecCount > 0 Then
drsHrsCur.FindFirst ("fldstrEmpID = '" &
Me.tbxfldstrEmpIDUnbound.Value & "'")
End If
If drsHrsCur.NoMatch = False And lngRecCount > 0 Then
If drsHrsCur.Fields("fldstrWrkCode").Value =
Me.cbxfldstrWrkCode.Value And bolLogOut = False Then
MsgBox "You are already logged into this work code.", 48
Exit Sub
Else
drsHrsHist.Requery
drsHrsHist.AddNew
drsHrsHist.Fields("fldstrEmpID").Value =
drsHrsCur.Fields("fldstrEmpID").Value
drsHrsHist.Fields("fldstrWrkCode").Value =
drsHrsCur.Fields("fldstrWrkCode").Value
drsHrsHist.Fields("flddblLogStartTime").Value =
drsHrsCur.Fields("flddblLogStartTime").Value
drsHrsHist.Fields("flddblActStartTime").Value =
drsHrsCur.Fields("flddblActStartTime").Value
drsHrsHist.Fields("fldbolStartTimeAdj").Value =
drsHrsCur.Fields("fldbolStartTimeAdj").Value
drsHrsHist.Fields("fldstrUsrNamStartTimeAdj").Value =
drsHrsCur.Fields("fldstrUsrNamStartTimeAdj").Value
drsHrsHist.Fields("flddblLogEndTime").Value = dblCurTime
drsHrsHist.Fields("flddblActEndTime").Value =
CDate(Int(CDbl(dblCurTime) * 48 + 0.5) / 48)
drsHrsHist.Fields("fldbolEndTimeAdj").Value = False
drsHrsHist.Fields("fldstrUsrNamEndTimeAdj").Value =
modDB.strUserName
drsHrsHist.Update
drsHrsCur.Delete
End If
End If
'Update Current Hours table for type of work going onto.
If bolLogOut = False Then
drsHrsCur.AddNew
drsHrsCur.Fields("fldstrEmpID").Value =
Me.tbxfldstrEmpIDUnbound.Value
drsHrsCur.Fields("fldstrWrkCode").Value = Me.cbxfldstrWrkCode.Value
drsHrsCur.Fields("flddblLogStartTime").Value = dblCurTime
drsHrsCur.Fields("flddblActStartTime").Value =
CDate(Int(CDbl(dblCurTime) * 48 + 0.5) / 48)
drsHrsCur.Fields("fldbolStartTimeAdj").Value = False
drsHrsCur.Fields("fldstrUsrNamStartTimeAdj").Value =
modDB.strUserName
drsHrsCur.Update
End If
Me.tbxfldstrEmpIDUnbound.Value = ""
Me.tbxfldstrEmpIDUnbound.SetFocus
End Sub


--

Sincerely,

Ronald R. Dodge, Jr.
Master MOUS 2000
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Coding Help for Beginner 0
Word macro that can call cells out of Excel for a find and replace 0
Working outlook via vba code with xlsx - error 0
Making a macro only work on certain files 2
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
Drop down list control value in vba 2
VBA - exporting serial letters to single documents 0
VBA Export to PDF 0

Top