Visual Basic para Aplicaciones - Mensaje de Error

Hola a todos:
Tengo el siguiente codigo en un boton del formulario llamado frmCierredecaja, lo que me hace es realizar una suma de un campo de una tabla de la base de datos.

datPrimaryRS.Recordset.Open "Select *from Ingresos where fecha='" & _frmCierredecaja.Text2.Text & "'", conn, adOpenStatic, adLockOptimistic
If datPrimaryRS.Recordset.RecordCount > 0 Then
Do While Not rs.EOF
suma = suma + datPrimaryRS.Recordset("Total_Monto")
datPrimaryRS.Recordset.MoveNext
Loop
End If
frmCierredecaja.Text3.Text = suma

Ahora viene el problema, cuando apreto el boton me salta un error diciendome que no se puede realizar la operacion si el objeto esta abierto, calculo que con objeto se debe referir al formulario. El tema que yo quiero realizarlo con el formulario abierto, alguien me puede decir cual es el error? - Muchas gracias a todos.

HOLA QUE TAL

EN TU CODIGO LO UNICO QUE VEO QUE NO CIERRAS EL Recordset. AL FINAL DEL CICLO Y TAMBIEN CHECAR EL VALOR DE LA PROPIEDAD EOF PARA VER SI CARGO INFORMACION O NO, Y SI NO, SALIRTE DEL SUB.

datPrimaryRS.Recordset.Open "Select *from Ingresos where fecha='" & _frmCierredecaja.Text2.Text & "'", conn, adOpenStatic, adLockOptimistic

If datPrimaryRS.Recordset.EOF=TRUE Then
datPrimaryRS.CLOSE ' CIERRAS
EXIT SUB '' TE SALES DEL SUB
END IF

Do While datPrimaryRS.Recordset.EOF = FALSE
suma = suma + datPrimaryRS.Recordset("Total_Monto")
datPrimaryRS.Recordset.MoveNext
Loop
datPrimaryRS.CLOSE

frmCierredecaja.Text3.Text = suma

SI EL ERROR CONTINUA, DETEN EL CODIGO ANTES DE CARGAR EL RS Y CON F8 SIGUE LINEA POR LIENA, QUIZAS EL ERROR VENGA DESDE OTRO OBJETO.

ESPERO TE SIRVA, SALUD2

HOLA, GRACIAS POR TU AYUDA PERO ME SIGUE PONIENDO EL MENSAJE DE LA BASE DE DATOS "NO SE PERMITE LA OPERACION MIENTRAS EL OBJETO ESTE ABIERTO"

ESPERO TU AYUDA NUEVAMENTE

MUCHAS GRACIAS

HOLA QUE TAL
SI GUSTAS MANDARME EL CODIGO POR MAIL CON GUSTO TE AYUDO.

SALUD2

EL CODIGO QUE PUSE ES EL QUE ME DISTE VOS, FIJATE DOS LINEAS ATRAS VOS ME DISTE LA RESPUESTA

SALUDOS

QUE TAL

YO DIGO, EL FORMULARIO EN SI, NO NADAMAS LA SUBRUTINA, PARA VER QUE OTROS, OBJETOS TIENES Y TRAZAR LIENA POR LINEA. PARA DETECTAR EL ERROR.

SALUD2

HOLA VICTOR, ACA TE PUSE TODO LO QUE TENGO EN EL FORMULARIO, EVENTO POR EVENTO. MUCHAS GRACIAS DE NUEVO

SALUDOS

Private Sub Command1_Click()
***********************************************************************************
Mensaje = MsgBox("¿ Confirma cierre de caja por $ " & Text5.Text & " ?", vbYesNo + vbDefaultButton2 + vbQuestion, "Cierre de caja")
If Mensaje = vbYes Then

On Error GoTo UpdateErr

datPrimaryRS.Recordset.UpdateBatch adAffectAll
Command1.Enabled = False
Command1.BackColor = vbWhite
Text3.Enabled = False
Text4.Enabled = False
Text5.Enabled = False
cmdAdd.Visible = True
cmdUpdate.Visible = True
cmdRefresh.Visible = True
cmdClose.Visible = True
Text1.Visible = False
Mensajeuno = MsgBox("Cierre de caja del día " & Text2.Text & " ha sido guardado correctamente" + Chr(10) + "¿ Desea imprimir el comprobante ?", vbYesNo + vbDefaultButton2 + vbInformation, "Cierre de caja")
End If

Exit Sub
UpdateErr:
MsgBox Err.Description
End Sub
*****************************************************************************************
Private Sub Command1_GotFocus()
*****************************************************************************************
Command1.BackColor = vbYellow
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Command1.Enabled = True Then
If MsgBox("¿ Desea salir ?" + Chr(10) + "El cierre de caja no ha sido guardado", vbYesNo + vbDefaultButton2 + vbExclamation, "Cierre de caja") = vbYes Then
Unload Me
Else
Cancel = True
End If
End If
End Sub
*****************************************************************************************
Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
******************************************************************************************
'This is where you would put error handling code
'If you want to ignore errors, comment out the next line
'If you want to trap them, add code here to handle them
MsgBox "Data error event hit err:" & Description
End Sub
*****************************************************************************************
Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
*****************************************************************************************
'This will display the current record position for this recordset
datPrimaryRS.Caption = "Record: " & CStr(datPrimaryRS.Recordset.AbsolutePosition)
End Sub
*****************************************************************************************
Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
*****************************************************************************************
'This is where you put validation code
'This event gets called when the following actions occur
Dim bCancel As Boolean

Select Case adReason
Case adRsnAddNew
Case adRsnClose
Case adRsnDelete
Case adRsnFirstChange
Case adRsnMove
Case adRsnRequery
Case adRsnResynch
Case adRsnUndoAddNew
Case adRsnUndoDelete
Case adRsnUndoUpdate
Case adRsnUpdate
End Select

If bCancel Then adStatus = adStatusCancel
End Sub
*****************************************************************************************
Private Sub cmdAdd_Click()
*****************************************************************************************
Text1.Visible = True
Text3.Enabled = True
Text4.Enabled = True
Text5.Enabled = True
Command1.Enabled = True
cmdAdd.Visible = False
cmdRefresh.Visible = False
cmdUpdate.Visible = False

On Error GoTo AddErr
datPrimaryRS.Recordset.AddNew
Command1.SetFocus
frmCierredecaja.Caption = "Cierre de caja (ALTA)"
Label1.Caption = " Alt + S (Salir)"
ACA PUSE EL CODIGO QUE VOS ME DIJISTE Y REEMPLAZE LO QUE VES AHORA, PERO ME DIO EL MISMO ERROR
datPrimaryRS.Recordset.Open "Select *from Ingresos where fecha='" & frmCierredecaja.Text2.Text & "'", conn, adOpenStatic, adLockOptimistic
If datPrimaryRS.Recordset.RecordCount > 0 Then
Do While Not datPrimaryRS.EOFAction
suma = suma + datPrimaryRS.Recordset("Total_Monto")
datPrimaryRS.Recordset.MoveNext
Loop
End If
frmCierredecaja.Text3.Text = suma

Exit Sub
AddErr:
MsgBox Err.Description
End Sub
*****************************************************************************************
Private Sub cmdDelete_Click()
*****************************************************************************************
On Error GoTo DeleteErr
With datPrimaryRS.Recordset
.Delete
.MoveNext
If .EOF Then .MoveLast
End With
Exit Sub
DeleteErr:
MsgBox Err.Description
End Sub
*****************************************************************************************
Private Sub cmdRefresh_Click()
Buscar = InputBox("Ingrese el nro de orden que desea reimprimir" + Chr(10) + "y pulse la tecla ENTER", "Reimpresión")
If Buscar = "" Then
frmCierredecaja.Show
Else
datPrimaryRS.Recordset.Find "[Nro de orden]=" + Buscar
frmCierredecaja.Caption = "Cierre de caja (REIMPRESION)"
End If
If txtFields(0) = "" Then
Mensaje = MsgBox("No hay cierres existentes con el nro de orden ingresado", vbInformation, "Reimpresión")
datPrimaryRS.Recordset.MoveFirst
frmCierredecaja.Caption = "Cierre de caja"
End If
End Sub
******************************************************************************************
Private Sub cmdUpdate_Click()
******************************************************************************************
Buscar = InputBox("Ingrese el nro de orden que desea consultar" + Chr(10) + "y pulse la tecla ENTER", "Consulta")
If Buscar = "" Then
frmCierredecaja.Show
Else
datPrimaryRS.Recordset.Find "[Nro de orden]=" + Buscar
frmCierredecaja.Caption = "Cierre de caja (CONSULTA)"
End If
If txtFields(0) = "" Then
Mensaje = MsgBox("No hay cierres existentes con el nro de orden ingresado", vbInformation, "Consulta")
datPrimaryRS.Recordset.MoveFirst
frmCierredecaja.Caption = "Cierre de caja"
End If
End Sub
******************************************************************************************
Private Sub cmdClose_Click()
If Command1.Enabled = True Then
Mensaje = MsgBox("¿ Desea salir ?" + Chr(10) + "El cierre de caja no ha sido guardado", vbYesNo + vbDefaultButton2 + vbExclamation, "Cierre de caja")
Else
If Command1.Enabled = False Then
Command1.Enabled = False
Unload Me
End If
End If
If Mensaje = vbYes Then
Command1.Enabled = False
Unload Me
End If
End Sub
******************************************************************************************
Private Sub Text2_LostFocus()
Dim Fecha As Integer

On Error GoTo Solución
Fecha = Date - CDate(Text2.Text)
Exit Sub
Solución:
Text2.Text = Date
Text2.Enabled = False
Resume
End Sub
******************************************************************************************

DEBES DE CERRAR ANDTES DE CARGAR EL SELECT, PORQUE YA EXISTE EL VINCULO DEL OBJETO CON LA TABLA.

YA LO HICE PRUEBAS Y ESTO FUE LO QUE HICE, PERO LA CONEXION ORIGINAL SE PIERDE, ENTONCES TIENES QUE DARLE CLICK A REFRESH PARA VOLVER A LA CONEXION .

datPrimaryRS.Recordset.Close
datPrimaryRS.Recordset.Open "Select *from CLIENTES;"
If datPrimaryRS.Recordset.RecordCount > 0 Then
Do While Not datPrimaryRS.Recordset.EOF
suma = suma + datPrimaryRS.Recordset("Monto")
datPrimaryRS.Recordset.MoveNext
Loop
End If
frmCierredecaja.Text3.Text = suma

YO NO USO ESTE TIPO DE ENLACES EN MIS PROYECTOS, NO SE MA HACE COMODO, ESTO QUE TE PUSE FUNSIONA PERO SINCERAMENTE NO SE SI ES CORRECTO , MANEJARLO DE ESA MANERA.

ESPERO TE SIRVA , SALUD2