REquery and DAO.recordset

[lios1984]

Hi to everyone!!

Ia have trouble with my code. It gives me "runtime error 3251: This operation is not supported by this type of object" about my Requery. I requery a DAO.recordset. What could it be??

 

[Yonnel]

Hi,

Can you give us the code you are using?

 

[Yonnel]

Please edit your message and use the CODE tags!
Else it is impossible to read the code

 

[lios1984]

Option Compare Database
Option Explicit

Public Sub random_assignment()

    Dim dbase As DAO.Database
    Dim rsTemp_status As DAO.Recordset
    Dim rsEvaluators As DAO.Recordset
    Dim rsProject As DAO.Recordset
    Dim rs As DAO.Recordset
    Dim sSQL As String

    Dim rando As Variant

    Dim evalregion As String
    Dim evalname As String
    Dim evalstatus As String
    Dim apprassign As Boolean

    Dim numfak As Integer

    Set dbase = CurrentDb

    'SS ------- Deletes previous assignments
    dbase.Execute ("DELETE * FROM [Temporary assignments]"), dbFailOnError

    'Opens recordsets
    Set rsTemp_status = dbase.OpenRecordset("Temporary assignments")
    Set rsEvaluators = dbase.OpenRecordset("Evaluators")
    Set rsProject = dbase.OpenRecordset("Projects")


    'SS ------- Updates table with projects to be assigned
    sSQL = "INSERT INTO [Temporary assignments] ( [Project number] )"
    sSQL = sSQL & " SELECT Projects.[Project number]"
    sSQL = sSQL & " FROM Projects"
    sSQL = sSQL & " WHERE [Status] = 'Ready to be assigned';"
    dbase.Execute (sSQL), dbFailOnError
    rsTemp_status.Requery

    'move to beginning of recordset
    rsTemp_status.MoveFirst

    'Searches table of projects
    Do Until rsTemp_status.EOF
        numfak = rsTemp_status![Project number]
        rsEvaluators.MoveFirst

        '---------------------------------------------------------------------------------------------------------------------------------
        'select the 1st evaluator

        apprassign = True
        Do Until apprassign = False   'Function eval is called until its value is False
            rando = Rand(1, DCount("[ID]", "Evaluators", "[Evaluator_Status] = 'Διαθέσιμος/η'"))

            sSQL = "SELECT [Evaluator name],[Evaluator region],[Evaluator_Status]"
            sSQL = sSQL & " FROM Evaluators"
            sSQL = sSQL & " WHERE [ID] = " & rando
            Set rs = dbase.OpenRecordset(sSQL)
            'check for record
            If Not (rs.BOF And rs.EOF) Then
                evalname = rs![Evaluator name]
                evalregion = rs![Evaluator region]
                evalstatus = rs![Evaluator_Status]

                ' returns a boolean - True or False
                apprassign = GetEval(evalregion, evalstatus, numfak)
            End If
        Loop
        rs.Close

        With rsTemp_status   'Insert evaluator's name
            .Edit
            .Fields("Assign to 1st evaluator") = evalname
            .Update
        End With

        'SS ------ Evaluator is temporarily taken out of the selection group
        sSQL = "UPDATE tblevaluators "
        sSQL = sSQL & " SET tblevaluators.[Evaluator_Status] = 'Bound'"
        sSQL = sSQL & " WHERE tblevaluators![Evaluator name] = '" & evalname & "';"
        dbase.Execute (sSQL), dbFailOnError
        '---------------------------------------------------------------------------------------------------------------------------------

        'select the 2nd evaluator

        apprassign = True
        Do Until apprassign = False   'Function eval is called until its value is False
            rando = Rand(1, DCount("[ID]", "Evaluators", "[Evaluator_Status] = 'Διαθέσιμος/η'"))

            sSQL = "SELECT [Evaluator name],[Evaluator region],[Evaluator_Status]"
            sSQL = sSQL & " FROM Evaluators"
            sSQL = sSQL & " WHERE [ID] = " & rando
            Set rs = dbase.OpenRecordset(sSQL)
            If Not (rs.BOF And rs.EOF) Then
                evalname = rs![Evaluator name]
                evalregion = rs![Evaluator region]
                evalstatus = rs![Evaluator_Status]

                ' returns a boolean - True or False
                apprassign = GetEval(evalregion, evalstatus, numfak)
            End If
        Loop
        rs.Close

        With rsTemp_status
            .Edit
            .Fields("Assign to 2nd evaluator") = evalname
            .Update
        End With

        '---------------

        sSQL = "UPDATE tblevaluators "
        sSQL = sSQL & " SET tblevaluators.[Evaluator_Status] = 'Bound'"
        sSQL = sSQL & " WHERE tblevaluators![Evaluator name] = '" & evalname & "';"
        dbase.Execute (sSQL), dbFailOnError
        '---------------

        rsTemp_status.MoveNext
    Loop


    'Restore all evaluators in order to be random selected again on next round of assignments
    sSQL = "UPDATE tblevaluators "
    sSQL = sSQL & " SET tblevaluators.[Evaluator_Status] = 'Διαθέσιμος/η'"
    sSQL = sSQL & " WHERE tblevaluators![Evaluator_Status] = 'Bound';"
    dbase.Execute (sSQL), dbFailOnError


    DoCmd.OpenReport "Assignment", acViewPreview   'Open report with assginments
    'Close tables and database
    rsTemp_status.Close
    rsEvaluators.Close
    rsProject.Close

    Set rsProject = Nothing
    Set rsTemp_status = Nothing
    Set rsEvaluators = Nothing
    Set rs = Nothing
    Set dbase = Nothing

End Sub



Public Function Rand(ByVal Low As Long, ByVal High As Long) As Long
   Randomize
   Rand = Int((High - Low + 1) * Rnd) + Low
End Function



Function GetEval(evalregion As String, evalstatus As String, numfak As Integer) As Boolean
   Dim region As String
   Dim dbase As DAO.Database
   Dim tblproject As DAO.Recordset

   Set dbase = CurrentDb

   'default return value to "False"
   GetEval = False

   Set tblproject = dbase.OpenRecordset("SELECT Region FROM Projects WHERE [Project number] = " & numfak)
   If Not (tblproject.BOF And tblproject.EOF) Then
      tblproject.MoveFirst
      region = tblproject!region
   End If

   If evalstatus = "Διαθέσιμος/η" Then
      If region = evalregion Then
         GetEval = False
      Else
         GetEval = True
      End If
   End If

   tblproject.Close
   Set tblproject = Nothing
   Set dbase = Nothing

End Function

 

[Yonnel]

Hello again!

I am not sure about the cause but why don't you just open the recordset after the insert query instead of using a requery?

'SS ------- Updates table with projects to be assigned
    sSQL = "INSERT INTO [Temporary assignments] ( [Project number] )"
    sSQL = sSQL & " SELECT Projects.[Project number]"
    sSQL = sSQL & " FROM Projects"
    sSQL = sSQL & " WHERE [Status] = 'Ready to be assigned';"
    dbase.Execute (sSQL), dbFailOnError

    'Opens recordsets
    Set rsEvaluators = dbase.OpenRecordset("Evaluators")
    Set rsProject = dbase.OpenRecordset("Projects")
    Set rsTemp_status = dbase.OpenRecordset("Temporary assignments")
    'rsTemp_status.Requery

-----
Lionel Garnier
http://www.gylsolutions.fr - IT consulting, VBA, Access trainings, Excel trainings, PowerPoint trainings

 

[lios1984]

Thank you very much for your help. It worked!!!