I am using ADODB connectivity in Access. I am creating two multiple records sets and When i am try to use mulitple record sets with a while loop
it gives an error operation not allowed when the object is open
Code:
Option Compare Database
'Dim Recordset As ADODB.Recordset
'Public Rc As ADODB.Recordset
----------------------------------
Private Sub SearchButton_Click()
'Dim txtData
'Dim Connection As New ADODB.Connection
Dim Recordset As New ADODB.Recordset
On Error GoTo ErrorHandler01
If Frame16.Value = 2 Then
If IsNull(Text26.Value) Or Text26.Value = "" Then
MsgBox "Please enter a value"
GoTo ExitProc
End If
End If
If Frame16.Value = 1 Then
If Not IsDate(Text24.Value) Or Text24.Value = "" Or IsNull(Text24.Value) Then
MsgBox "Please enter a value"
GoTo ExitProc
End If
End If
txtSQLD = "Select * from ClaimPayment where ChargeDate = #" + Str(Text24.Value) + "#"
txtSQLC = "Select * from ClaimPayment where ClaimID = '" + Text26.Value + "'"
Connection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=E:\N_Data\EMR\emrdata.mdb"
Set Rc = New ADODB.Recordset
'Set Recordset = New ADODB.Recordset
'Call Rc.Open("select * from claimpayment", Connection, adOpenDynamic, adLockOptimistic)
If Frame16.Value = 2 Then
'Call Recordset.Open(txtSQLC, Connection, adOpenDynamic, adLockOptimistic)
Call Rc.Open(txtSQLC, Connection, adOpenDynamic, adLockOptimistic)
End If
If Frame16.Value = 1 Then
Call Rc.Open(txtSQLD, Connection, adOpenDynamic, adLockOptimistic)
End If
temp = Rc("ClaimID").Value
If Not Rc.EOF Then
Rc.MoveFirst
Else
List12.RowSource = "No records Found"
Exit Sub
End If
Dim tempData As String
Do While Not Rc.EOF
If IsNull(Rc("PatientName").Value) Then
tempD = " "
Else
tempD = Rc("PatientName").Value
End If
'tempD = IIf(Recordset("PatientName").Value = Null, "", Recordset("PatientName").Value)
textList = ""
textList = textList + tempD
textList = textList + " "
textList = textList + Rc("ClaimID").Value
textList = textList + " "
textList = textList + Str(Rc("ChargeDate").Value)
tempData = tempData + textList + ";"
Rc.MoveNext
Loop
List12.RowSource = tempData
Exit Sub
ExitProc:
Exit Sub
ErrorHandler01:
MsgBox Err.Description
MsgBox Err.Source
End Sub
it gives an error operation not allowed when the object is open
Code:
Option Compare Database
'Dim Recordset As ADODB.Recordset
'Public Rc As ADODB.Recordset
----------------------------------
Private Sub SearchButton_Click()
'Dim txtData
'Dim Connection As New ADODB.Connection
Dim Recordset As New ADODB.Recordset
On Error GoTo ErrorHandler01
If Frame16.Value = 2 Then
If IsNull(Text26.Value) Or Text26.Value = "" Then
MsgBox "Please enter a value"
GoTo ExitProc
End If
End If
If Frame16.Value = 1 Then
If Not IsDate(Text24.Value) Or Text24.Value = "" Or IsNull(Text24.Value) Then
MsgBox "Please enter a value"
GoTo ExitProc
End If
End If
txtSQLD = "Select * from ClaimPayment where ChargeDate = #" + Str(Text24.Value) + "#"
txtSQLC = "Select * from ClaimPayment where ClaimID = '" + Text26.Value + "'"
Connection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=E:\N_Data\EMR\emrdata.mdb"
Set Rc = New ADODB.Recordset
'Set Recordset = New ADODB.Recordset
'Call Rc.Open("select * from claimpayment", Connection, adOpenDynamic, adLockOptimistic)
If Frame16.Value = 2 Then
'Call Recordset.Open(txtSQLC, Connection, adOpenDynamic, adLockOptimistic)
Call Rc.Open(txtSQLC, Connection, adOpenDynamic, adLockOptimistic)
End If
If Frame16.Value = 1 Then
Call Rc.Open(txtSQLD, Connection, adOpenDynamic, adLockOptimistic)
End If
temp = Rc("ClaimID").Value
If Not Rc.EOF Then
Rc.MoveFirst
Else
List12.RowSource = "No records Found"
Exit Sub
End If
Dim tempData As String
Do While Not Rc.EOF
If IsNull(Rc("PatientName").Value) Then
tempD = " "
Else
tempD = Rc("PatientName").Value
End If
'tempD = IIf(Recordset("PatientName").Value = Null, "", Recordset("PatientName").Value)
textList = ""
textList = textList + tempD
textList = textList + " "
textList = textList + Rc("ClaimID").Value
textList = textList + " "
textList = textList + Str(Rc("ChargeDate").Value)
tempData = tempData + textList + ";"
Rc.MoveNext
Loop
List12.RowSource = tempData
Exit Sub
ExitProc:
Exit Sub
ErrorHandler01:
MsgBox Err.Description
MsgBox Err.Source
End Sub