VBA ADO / Runtime Error 3704

[psycoperl]

Hi all,

i am getting a run time error '3704' Operation is not allowed when the object is closed.

On the line " rsReg.Close " in ImportStudentCreateAppointments ( I flagged it with ' ### ERROR HERE to make it easier to see)

However, i had not closed it yet. Can you advise as to what is going on?


Thank you for your assistance.

Sub ImportStudentCreateAppointments()
        
    Debug.Print "Entering ImportStudentCreateAppointments: "
    Debug.Print "Create Registration Appointments for Imported Students"
    Debug.Print ""
      
    Dim strTestSessionID As String
            
'Create Record Set To Work With
'Load Data From tblTempSimNetResultData
    Dim rsSNReport As ADODB.Recordset
    Set rsSNReport = New ADODB.Recordset
    rsSNReport.ActiveConnection = CurrentProject.Connection
    rsSNReport.CursorType = adOpenDynamic
    rsSNReport.LockType = adLockOptimistic
    rsSNReport.Open "Select * From tblTempAddStudentTable"

'rsReg - this is the registration table
    Dim rsReg As ADODB.Recordset
    Set rsReg = New ADODB.Recordset
    rsReg.ActiveConnection = CurrentProject.Connection
    rsReg.CursorType = adOpenDynamic
    rsReg.LockType = adLockOptimistic
  
    If Not rsSNReport.BOF Then
        rsSNReport.MoveFirst
    End If

    Debug.Print "EOF " & rsSNReport.EOF

    Do While Not rsSNReport.EOF
        Debug.Print " "
        Debug.Print "Check for Student ID: " & rsSNReport![Student ID]
        Debug.Print "...TransSimNetDate: " & rsSNReport![transSimNetDate]
        Debug.Print "...TransSimNetTime: " & rsSNReport![transSimNetTime]
      
        If Len(Trim(rsSNReport![transSimNetDate])) < 5 Or IsNull(rsSNReport![transSimNetDate]) Then
            Debug.Print "... ### ERROR ### No SimNet Date... Skipping"
        Else
            If Len(Trim(rsSNReport![transSimNetTime])) < 5 Or IsNull(rsSNReport![transSimNetTime]) Then
                Debug.Print "... ### ERROR ### No SimNet Time... Skipping"
            Else
                strTestSessionID = _
                    TestSessionSearchExists(rsSNReport![transSimNetDate] & " " & rsSNReport![transSimNetTime])
                If strTestSessionID <> "0000" Then
                    If Not AlreadyRegistered(rsSNReport![Student ID], strTestSessionID) Then
                        CreateRegistrationRecord rsSNReport![Student ID], strTestSessionID
                    Else
                        Debug.Print "....Student already had appointment for this session"
                    End If
                Else
                    Debug.Print "Session not found... not creating registration record for " & rsSNReport![Student ID]
                End If
            End If
        End If
    rsSNReport.MoveNext
    Loop
    
    rsReg.Close ' ### ERROR  HERE
    Set rsReg = Nothing
    
    If rsSNReport.EOF Then
        rsSNReport.MoveFirst
    End If
    
    Do While Not rsSNReport.EOF
        rsSNReport.Delete
        rsSNReport.MoveNext
    Loop
    
    rsSNReport.Close
    Set rsSNReport = Nothing
    
    Debug.Print "Exiting ImportStudentCreateAppointments "
    
End Sub

Sub CreateRegistrationRecord(strStuID As String, strTestSession As String)

    Dim rsReg1 As ADODB.Recordset
    Set rsReg1 = New ADODB.Recordset
    rsReg1.ActiveConnection = CurrentProject.Connection
    rsReg1.CursorType = adOpenDynamic
    rsReg1.LockType = adLockOptimistic
    rsReg1.Open "tblRegistration"
    
    rsReg1.AddNew
    rsReg1![stuID] = strStuID
    rsReg1![tsTestSession] = strTestSession
    rsReg1![regTaken] = False
    rsReg1![regAutoAppointment] = True
    Debug.Print "Creating Record for " & strStuID & " to attend session # " & strTestSession
    rsReg1.Update
    
    rsReg1.Close
    Set rsReg1 = Nothing
    
End Sub

Public Function AlreadyRegistered(stuID As String, strTestSession As String) As Boolean
    Dim bolstatus As Boolean
    bolstatus = False

    Dim rsReg2 As ADODB.Recordset
    Set rsReg2 = New ADODB.Recordset
    rsReg2.ActiveConnection = CurrentProject.Connection
    rsReg2.CursorType = adOpenDynamic
    rsReg2.LockType = adLockOptimistic
    rsReg2.Open "Select * from tblRegistration Where stuID = '" & stuID & "' AND tsTestSession = " & strTestSession
    
    Debug.Print "rsReg2 BOF: " & rsReg2.BOF & "   rsReg2 EOF: " & rsReg2.EOF
    
           
    If Not rsReg2.BOF Then
        rsReg2.MoveFirst
    End If
    
    If Not rsReg2.EOF Then
        bolstatus = True
    Else
        bolstatus = False
    End If
    
    rsReg2.Close
    Set rsReg2 = Nothing
    
    AlreadyRegistered = bolstatus

End Function

Public Function TestSessionSearchExists(strSession As String) As String

'### Function to get Test Session ID
Dim tsID As Integer

Debug.Print ".//. Entering TestSessionSearchExists "
Debug.Print ".//. Looking for SessionID Number for: " & strSession


Dim rsTSS As ADODB.Recordset
Set rsTSS = New ADODB.Recordset
rsTSS.ActiveConnection = CurrentProject.Connection
rsTSS.CursorType = adOpenStatic
rsTSS.LockType = adLockPessimistic
rsTSS.Open "Select tsID From tblTestSession Where tsSession = #" & strSession & "#"

If Not rsTSS.BOF Then
    rsTSS.MoveFirst
End If

If Not rsTSS.EOF Then
    Debug.Print ".//. .. Session Found - ID #: " & rsTSS!tsID
    tsID = rsTSS!tsID
Else
    Debug.Print ".//. .. Session data NOT Found! "
    tsID = "0000"
End If

rsTSS.Close

Set rsTSS = Nothing

TestSessionSearchExists = tsID

Debug.Print ".//. Exiting TestSessionSearchExists "

End Function

 

[SydneyGeek]

It doesn't look like you opened the recordset. You defined its parameters, but haven't assigned a table to it.

Denis

 

[psycoperl]

It doesn't look like you opened the recordset. You defined its parameters, but haven't assigned a table to it.

Denis

Thanks for your help.

Thats what happens when I try to be smart and use a function and procedure to clean up my code but dont take all the obsoleted code out