No Current Record (1 Viewer)

[kevnaff]

Hi All,

I've got a command button that was working OK in Access 2010, but since upgrading to Access 365, I've been received a 'No Current Record' message.

The full code behind this command button is included at the bottom. I have done some process of elimination with the code an found that the following parts of the code are causing the issue.

' Count records in found set

Set db = CurrentDb()

Set REC = db.OpenRecordset("PPMAutoJobs", dbOpenDynaset)

REC.MoveLast

TotalRecords = REC.RecordCount

REC.Close

'Create Jobs

Set db = CurrentDb()

Set REC = db.OpenRecordset("PPMAutoJobs", dbOpenDynaset)

Set REC2 = db.OpenRecordset("Assignment Ledger 2", dbOpenDynaset)

REC.MoveFirst



For n = 1 To TotalRecords

REC2.AddNew

REC2("Code No") = REC("Code No")

REC2("Work Category") = "PLANNED PREVENTATIVE MAINTENANCE"

REC2("Institution") = REC("Institution")

REC2("Department") = REC("Owner department")

REC2("Directorate") = REC("Directorate")

REC2("Work Details") = "*** MEDIPRO 2000 GENERATED PPM *** THE LAST RECORDED LOCATION WAS... " _

& REC("Location")

REC2("Date In") = Date

REC2("Job Status") = "AWAITING INSPECTION"

REC2("Edited by") = "MEDIPRO"

REC2("CreatedBy") = "MEDIPRO"

REC2("Edited date") = Now

REC2.Update

REC.MoveNext

Next n



REC.Close

REC2.Close

As I'm not too familiar with VBA, I was hoping it may be something simple as the code was likely written 20+ years ago.

Does anybody have any experience with an issue like this?

On Error GoTo Err_CommandCreateJobs_Click
' Medipro 2000 Automatic PPM Generation and Job Entering Utility By P.Moyers 8/4/00

' Declare Variables
   Dim db As Database
   Dim REC As Recordset, REC2 As Recordset
   Dim stDocName As String
   Dim strSql As String
   Dim Response, Message, Style, Title
   Dim TotalRecords As Integer
   Dim frm As Form
   Dim n As Integer
   Dim qdf As QueryDef
   Dim varMandated As Variant
  
MainProgram:

' Store Applied Filter as Query
strSql = "Select * from QueryPPMScheduler where " & Me.Filter
Set qdf = CurrentDb.QueryDefs("PPMFilter")
qdf.SQL = strSql
qdf.Close


'PPMFilter is compared with JobsNotDone query to create PPMAutoJobs query.
'PPMAutoJobs does not contain any jobs already booked on ledger.

' Count records in found set
Set db = CurrentDb()
Set REC = db.OpenRecordset("PPMAutoJobs", dbOpenDynaset)
REC.MoveLast
TotalRecords = REC.RecordCount
REC.Close
 
' Get out message
Message = "Medipro2000 will Automatically create " & TotalRecords & _
            " PPM Jobs in the Assignment Ledger from the found set of records" _
            & Chr(10) & "Jobs currently on ledger will not be duplicated" _
            & Chr(10) & "Do you wish to continue?"
Title = "Medipro2000 Auto PPM Job Builder"
Response = MsgBox(Message, vbOKCancel, Title)
If Response = vbCancel Then GoTo Exit_CommandCreateJobs_Click

'Create Jobs
Set db = CurrentDb()
Set REC = db.OpenRecordset("PPMAutoJobs", dbOpenDynaset)
Set REC2 = db.OpenRecordset("Assignment Ledger 2", dbOpenDynaset)
REC.MoveFirst

For n = 1 To TotalRecords
REC2.AddNew
REC2("Code No") = REC("Code No")
REC2("Work Category") = "PLANNED PREVENTATIVE MAINTENANCE"
REC2("Institution") = REC("Institution")
REC2("Department") = REC("Owner department")
REC2("Directorate") = REC("Directorate")
REC2("Work Details") = "*** MEDIPRO 2000 GENERATED PPM *** THE LAST RECORDED LOCATION WAS... " _
& REC("Location")
REC2("Date In") = Date
REC2("Job Status") = "AWAITING INSPECTION"
REC2("Edited by") = "MEDIPRO"
REC2("CreatedBy") = "MEDIPRO"
REC2("Edited date") = Now
REC2.Update
REC.MoveNext
Next n

REC.Close
REC2.Close

'Completed Message
Message = TotalRecords & " New PPM Jobs have been created in the Assignment Ledger"
Title = "Medipro2000 Auto PPM Job Builder"
Response = MsgBox(Message, vbOK, Title)





Exit_CommandCreateJobs_Click:
    Exit Sub

Err_CommandCreateJobs_Click:
    MsgBox Err.Description
    Resume Exit_CommandCreateJobs_Click

 

[Gasman]

You would get that message as you MoveLast without checking if you have any records?
Use either an EOF or BOF check before attempting a move.

 

[CJ_London]

the message implies that REC is not returning any records, so in both instances the .movelast and .movefirst have no records to go to

Some observations:
You don't need to open, close then reopen REC
Although probably not the issue, better not to have spaces in table and field names - As access matures it get less tolerant of poor design
this could all be done with just a couple of lines by executing an append query

Possible fix

Set db = CurrentDb()

Set REC = db.OpenRecordset("PPMAutoJobs", dbOpenDynaset)
If rec.EOF then
    msgbox "no records to process"
    exit sub
else
    REC.MoveLast
    TotalRecords = REC.RecordCount
    'REC.Close
 'you'll need an end if further down
' Get out message
Message = "Medipro2000 will Automatically create " & TotalRecords & _
            " PPM Jobs in the Assignment Ledger from the found set of records" _
            & Chr(10) & "Jobs currently on ledger will not be duplicated" _
            & Chr(10) & "Do you wish to continue?"
Title = "Medipro2000 Auto PPM Job Builder"
Response = MsgBox(Message, vbOKCancel, Title)
If Response = vbCancel Then GoTo Exit_CommandCreateJobs_Click

'Create Jobs
'Set db = CurrentDb()
'Set REC = db.OpenRecordset("PPMAutoJobs", dbOpenDynaset)
Set REC2 = db.OpenRecordset("Assignment Ledger 2", dbOpenDynaset)
REC.MoveFirst

 

[kevnaff]

the message implies that REC is not returning any records, so in both instances the .movelast and .movefirst have no records to go to

Some observations:
You don't need to open, close then reopen REC
Although probably not the issue, better not to have spaces in table and field names - As access matures it get less tolerant of poor design
this could all be done with just a couple of lines by executing an append query

Possible fix

Set db = CurrentDb()

Set REC = db.OpenRecordset("PPMAutoJobs", dbOpenDynaset)
If rec.EOF then
    msgbox "no records to process"
    exit sub
else
    REC.MoveLast
    TotalRecords = REC.RecordCount
    'REC.Close
'you'll need an end if further down
' Get out message
Message = "Medipro2000 will Automatically create " & TotalRecords & _
            " PPM Jobs in the Assignment Ledger from the found set of records" _
            & Chr(10) & "Jobs currently on ledger will not be duplicated" _
            & Chr(10) & "Do you wish to continue?"
Title = "Medipro2000 Auto PPM Job Builder"
Response = MsgBox(Message, vbOKCancel, Title)
If Response = vbCancel Then GoTo Exit_CommandCreateJobs_Click

'Create Jobs
'Set db = CurrentDb()
'Set REC = db.OpenRecordset("PPMAutoJobs", dbOpenDynaset)
Set REC2 = db.OpenRecordset("Assignment Ledger 2", dbOpenDynaset)
REC.MoveFirst

Hi CJ,

Since your message, I managed to find out an issue. The query PPMAutoJobs was not pulling up any records, which is why the "No Current Record" message was showing. I have since created a new query called PPMQueryPPMCreateJobsStep2 which now works perfectly. I have substituted this query in to the code below. It gets to the stage where it calculates the number of records to create. Once I click OK on this, I now get the following message:

Any ideas on what this means?

Thanks both for your help.

 

[Gasman]

Wlak through the code with F8 after setting a breakpoint and see what line produces the error.?
I am just going to guess it cannot find a querydef by that name?

 

[CJ_London]

no code below, but think Gasman is correct - you have a misspelling

 

[SHANEMAC51]

' Declare Variables
Dim db As Database
Dim REC As Recordset, REC2 As Recordset
Dim stDocName As String
Dim strSql As String
Dim Response, Message, Style, Title
Dim TotalRecords As Integer
Dim frm As Form
Dim n As Integer
Dim qdf As QueryDef
Dim varMandated As Variant

' Declare Variables
   Dim db As dao.Database
   Dim REC As dao.Recordset, REC2 As dao.Recordset


   Dim qdf As dao.QueryDef

I usually declare so as to guarantee a reference to the dao.
or should I put the dao link above the ado link in tools/references

 

[CJ_London]

not sure what you are doing but if you have copied this from your code I would expect to see

Dim db As DAO.Database
Dim REC As DAO.Recordset, REC2 As DAO.Recordset

with DAO not dao

 

[kevnaff]

Wlak through the code with F8 after setting a breakpoint and see what line produces the error.?
I am just going to guess it cannot find a querydef by that name?

Hi Gasman,

In the new query that I created, I only included [Code No] and I forgot to include the fields [Institution] [Owner Department] [Directorate] and [Location]. Since adding these fields to the query it is now working OK.

Thanks for your help.

For n = 1 To TotalRecords
REC2.AddNew
REC2("Code No") = REC("Code No")
REC2("Work Category") = "PLANNED PREVENTATIVE MAINTENANCE"
REC2("Institution") = REC("Institution")
REC2("Department") = REC("Owner department")
REC2("Directorate") = REC("Directorate")
REC2("Work Details") = "*** MEDIPRO 2000 GENERATED PPM *** THE LAST RECORDED LOCATION WAS... " _
& REC("Location")
REC2("Date In") = Date
REC2("Job Status") = "AWAITING INSPECTION"
REC2("Edited by") = "MEDIPRO"
REC2("CreatedBy") = "MEDIPRO"
REC2("Edited date") = Now
REC2.Update
REC.MoveNext
Next n

REC.Close
REC2.Close