Problema con guardar un registro utilizando ADO
San
13 de Mayo del 2004
Hola!
Mi problema es que no puedo guardar registros desde Visual Basic con tablas relacionadas en Access 2000.
estoy utilizando una conecci贸n a Access con ADO desde Visual Basic, puedo modificar cualquier registro directamente en la tabla padre, pero cuando modifico un registro relacionado con la tabla padre no me permite hacerlo y me saca del programa, pero cuando ingreso nuevamente el registro ya esta modificado, ¿como puedo hacer para que guarde los registros con los datos de las tablas relacionas?
Por favor si algui茅n tiene experienza con esto de manipular datos con tablas relacionadas me de un cnsejo para poder solucionarlo. He intentado buscar ayuda por internet, pero no hay mucha explicaci贸n sobre el tema.
Muchas gracias.
Mi problema es que no puedo guardar registros desde Visual Basic con tablas relacionadas en Access 2000.
estoy utilizando una conecci贸n a Access con ADO desde Visual Basic, puedo modificar cualquier registro directamente en la tabla padre, pero cuando modifico un registro relacionado con la tabla padre no me permite hacerlo y me saca del programa, pero cuando ingreso nuevamente el registro ya esta modificado, ¿como puedo hacer para que guarde los registros con los datos de las tablas relacionas?
Por favor si algui茅n tiene experienza con esto de manipular datos con tablas relacionadas me de un cnsejo para poder solucionarlo. He intentado buscar ayuda por internet, pero no hay mucha explicaci贸n sobre el tema.
Muchas gracias.
san
13 de Mayo del 2004
Puedo enviar mi archivo completo si me pasan su email para que lo chenquen y me den una sugerencia.
Mi email es: [email protected].
He puesto notas para que sepan en donde esta el error que no he podido corregir. Al leer el c贸digo veran la indicaci贸n.
Este es mi c贸digo para buscar datos..
No tengo problemas con esto.
Private Sub Buscar(Optional ByVal Siguiente As Boolean = False)
' Procedimiento para buscar el dato indicado (18/Ene/01)
' Si Siguiente = True, se busca a partir del registro activo
Dim nReg As Long
Dim vBookmark As Variant ' En ADO debe ser Variant, no vale un String
Dim sADOBuscar As String
'
' Iniciamos la detecci贸n de errores
On Error Resume Next
'
' Buscar la primera coincidencia en el recordset del ADO
'If Option1.Value Then
' Convertir el contenido de TextBox en un n煤mero
' nReg = Val(Text2)
' en el campo ID
' sADOBuscar = "IDExpediente = " & nReg
'End If
If Option1.Value Then
' en el campo Promotores
sADOBuscar = "Promotores Like '" & txtBuscar.Text & "'"
End If
If Option2.Value Then
' en el campo Clv_Expediente
sADOBuscar = "Clv_Expediente Like '" & txtBuscar.Text & "'"
End If
If Option3.Value Then
' en el campo Calle
sADOBuscar = "Calle Like '" & txtBuscar.Text & "'"
End If
If Option4.Value Then
' en el campo Fecha ingreso
sADOBuscar = "Fecha_Ingreso Like '" & txtBuscar.Text & "'"
End If
If Option5.Value Then
' en el campo Tipo_Tr谩mites
sADOBuscar = "TipoTramites Like '" & txtBuscar.Text & "'"
End If
If Option6.Value Then
' en el campo Departamentos
sADOBuscar = "Departamentos Like '" & txtBuscar.Text & "'"
End If
If Option7.Value Then
' en el campo Resultados
sADOBuscar = "Resultados Like '" & txtBuscar.Text & "'"
End If
' Guardar la posici贸n anterior, por si no se halla lo buscado...
vBookmark = datRegistros.Recordset.Bookmark
'
If Siguiente = False Then
' Buscar desde el principio
datRegistros.Recordset.MoveFirst
datRegistros.Recordset.Find sADOBuscar
Else
' Busca a partir del registro actual
datRegistros.Recordset.Find sADOBuscar, 1
End If
' Devolver谩 un error si no se halla lo buscado
' aunque no siempre es as铆...
If Err.Number Or datRegistros.Recordset.BOF Or datRegistros.Recordset.EOF Then
Err.Clear
MsgBox "No existe el dato buscado o ya no hay m谩s datos que mostrar."
' Posicionar el recordset en la posici贸n guardada
datRegistros.Recordset.Bookmark = vBookmark
End If
End Sub
ES c贸digo lo utilizo para abrir la informaci贸n de calles.
Aqu铆 es donde se encuentra mi tabla que esta relaciona. No tengo problemas con esto.
Private Sub cmdAbrirFrmCalles_Click()
frmCalles.Show 1
'Set frmCalles.datRegistros.Recordset = frmCalles.datRegistros
End Sub
ES c贸digo lo utilizo para abrir la informaci贸n de DEptos.
Aqu铆 es donde se encuentra mi tabla que esta relaciona. No tengo problemas con esto.
Private Sub cmdAbrirFrmDeptos_Click()
frmDepartamentos.Show 1
End Sub
Private Sub cmdAbrirFrmEmpleados_Click()
frmEmpleados.Show 1
End Sub
Private Sub cmdAbrirFrmPromotores_Click()
frmPromotores.Show 1
End Sub
Private Sub cmdAbrirFrmResultados_Click()
frmResultados.Show 1
End Sub
Private Sub cmdAbrirFrmTramites_Click()
frmTiposTramites.Show 1
End Sub
Private Sub cmdAdd_Click()
On Error GoTo AddErr
' A帽adir un nuevo registro
datRegistros.Recordset.AddNew
Exit Sub
AddErr:
MsgBox Err.Description
End Sub
Private Sub cmdBuscar_Click()
' Buscar el primer registro que coincida con el dato buscado
Call Buscar
End Sub
Private Sub cmdBuscarSig_Click()
Buscar True
End Sub
Private Sub cmdDelete_Click()
On Error GoTo AddErr
' Eliminar un registro
datRegistros.Recordset.Delete
' Movemos al primer registro para que los cambios se hagan permanentes
' (tambi茅n podriamos haberlo movido al 煤ltimo registro)
If datRegistros.Recordset.EOF Then
datRegistros.Recordset.MoveLast
Else
datRegistros.Recordset.MoveNext
End If
Exit Sub
AddErr:
MsgBox Err.Description
'End If
'frmEliminarRegistro.Show
'On Error GoTo AddErr
'Dim intRespuesta As Integer
' Borrar el registro actual
' Se comprueba que haya alg煤n registro activo,
' para ello se comprueba que no hayamos pasado del principio o el final del Recordset
'
' Comprobar que hay registros, porque si no hay, dar谩 error
' If (datRegistros.Recordset.EOF Or datRegistros.Recordset.BOF) Then
' Avisar de que no hay registros
' datRegistros.Caption = "Ning煤n registro activo"
'Else
' Eliminar el registro actual
' intRespuesta = MsgBox("Est谩 seguro de eliminar este registro?", vbYesNo + vbQuestion + vbDefaultButton2, "Eliminar Registro")
' If intRespuesta = vbNo Then
'Exit Sub
'Else
'datRegistros.Recordset.Delete
' Movemos al primer registro para que los cambios se hagan permanentes
' (tambi茅n podriamos haberlo movido al 煤ltimo registro)
'If datRegistros.Recordset.EOF Then
'datRegistros.Recordset.MoveLast
'Else
'datRegistros.Recordset.MoveNext
'End If
'End If
'Exit Sub
'AddErr:
'MsgBox Err.Description
'End If
End Sub
Private Sub cmdfrmDictamenenesBuscar_Click()
frmBuscar02.Show
End Sub
Private Sub cmdfrmDictCerrar_Click()
frmDictamen.Hide
frmMenuPrincipal.Show
End Sub
///***** aqu铆 es donde tengo problemas...
y el error es el siguiente al hacer click en el boton de comando cmdGuardarDict :
**** Multiple-Step operation Generated errors.
Check each status value.
Private Sub cmdGuardarDict_Click()
On Error GoTo AddErr
' A帽adir un nuevo registro
datRegistros.Recordset.Update
Exit Sub
AddErr:
MsgBox Err.Description
End Sub
Private Sub cmdReconsideracion_Click()
frmDictamen.Hide
frmHistorial.Adodc1.RecordSource = "SELECT * FROM HistorialMtrios WHERE IdExpediente = " & frmDictamen.txtIDExpediente.Text
frmHistorial.Adodc1.Refresh
Set frmHistorial.dgridHistorial.DataSource = frmHistorial.Adodc1
frmHistorial.Show
End Sub
Private Sub cmdRefresh_Click()
On Error GoTo RefreshErr
datRegistros.Refresh
Exit Sub
RefreshErr:
MsgBox Err.Description
End Sub
Private Sub cmdUpdate_Click()
On Error GoTo UpdateErr
datRegistros.Recordset.UpdateBatch adAffectAll
Exit Sub
UpdateErr:
MsgBox Err.Description
End Sub
'Private Sub datRegistros_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
' Mostrar el ID del registro actual
' si se pasa del primero o del 煤ltimo, dar谩 error
'On Error Resume Next
' Mostrar el ID del registro actual usando el recordset pasado como par谩metro
'datRegistros.Caption = "Registro actual: " & pRecordset.AbsolutePosition
'datRegistros.Caption = "Registro actual: " & pRecordset.AbsolutePosition & " de " & pRecordset.RecordCount
' Si da error, indicarlo (20/Sep/99)
' If Err Or pRecordset.BOF Or pRecordset.EOF Then
' datRegistros.Caption = "Ning煤n registro activo"
' Habr铆a que moverlo a un registro con informaci贸n
' *** Dejarlo comentado ***
' para que el procedimiento de b煤squeda avise si no hay datos activos
'Adodc1.Recordset.MoveFirst
'End If
'
'Err = 0
'End Sub
'Private Sub datRegistros_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'datRegistros.Caption = "Registro actual: " & pRecordset.AbsolutePosition & " de " & pRecordset.RecordCount
'End Sub
'Private Sub datRegistros_WillMove(ByVal adReason As ADODB.EventReasonEnum, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'End Sub
'Private Sub Form_Activate()
' datRegistros.Recordset.MoveLast
' datRegistros.Recordset.MoveFirst
' datRegistros.Caption = datRegistros.Recordset.RecordCount
'datRegistros.Recordset.RecordCount
'End Sub
/***En esta parte me conecto a mi base de datos.
Private Sub Form_Load()
'
txtBuscar = ""
Option2.Value = True
'cmdDelete.Enabled = False
cmdUpdate.Enabled = False
'cmdRefresh.Enabled = False
frmDictamen.datRegistros.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:vbDictaminaMinutariodictamin.mdb;Persist Security Info=False"
frmHistorial.Adodc1.ConnectionString = frmDictamen.datRegistros.ConnectionString
frmDictamen.datRegistros.RecordSource = "Q_Minutarios"
frmDictamen.datRegistros.Refresh
' Asignar a cada uno de las cajas de texto el campo de la tabla
'txtIDExpediente.DataField = "IDExpediente"
txtClvExpediente.DataField = "Clv_Expediente"
txtCallesDict.DataField = "Calle"
End Sub
Private Sub txtBuscar_KeyPress(KeyAscii As Integer)
' Se buscar谩 s贸lo cuando pulsemos INTRO
'
' Comprobar si la tecla pulsada es Intro: vbKeyReturn o 13 que es lo mismo
If KeyAscii = vbKeyReturn Then
On Error Resume Next
' Esta asignaci贸n evita que suene un BEEP
KeyAscii = 0
'
Buscar
End If
End Sub
En este formulario de frmDepartamentos tengo este c贸digo que es donde inserto el IDDepartamentos a Consulta Minutarios para posterior mente guardar los cambios desde el Formularios frmDictamen.
Private Sub cmdfrmDeptosAceptar_Click()
frmDictamen.txtDeptosDict.Text = txtIDDeptos.Text
frmDictamen.datRegistros.Recordset.Fields("IDDepartamentos") = txtIDDeptos.Text
frmDepartamentos.Hide
frmDictamen.Show
End Sub
Mi email es: [email protected].
He puesto notas para que sepan en donde esta el error que no he podido corregir. Al leer el c贸digo veran la indicaci贸n.
Este es mi c贸digo para buscar datos..
No tengo problemas con esto.
Private Sub Buscar(Optional ByVal Siguiente As Boolean = False)
' Procedimiento para buscar el dato indicado (18/Ene/01)
' Si Siguiente = True, se busca a partir del registro activo
Dim nReg As Long
Dim vBookmark As Variant ' En ADO debe ser Variant, no vale un String
Dim sADOBuscar As String
'
' Iniciamos la detecci贸n de errores
On Error Resume Next
'
' Buscar la primera coincidencia en el recordset del ADO
'If Option1.Value Then
' Convertir el contenido de TextBox en un n煤mero
' nReg = Val(Text2)
' en el campo ID
' sADOBuscar = "IDExpediente = " & nReg
'End If
If Option1.Value Then
' en el campo Promotores
sADOBuscar = "Promotores Like '" & txtBuscar.Text & "'"
End If
If Option2.Value Then
' en el campo Clv_Expediente
sADOBuscar = "Clv_Expediente Like '" & txtBuscar.Text & "'"
End If
If Option3.Value Then
' en el campo Calle
sADOBuscar = "Calle Like '" & txtBuscar.Text & "'"
End If
If Option4.Value Then
' en el campo Fecha ingreso
sADOBuscar = "Fecha_Ingreso Like '" & txtBuscar.Text & "'"
End If
If Option5.Value Then
' en el campo Tipo_Tr谩mites
sADOBuscar = "TipoTramites Like '" & txtBuscar.Text & "'"
End If
If Option6.Value Then
' en el campo Departamentos
sADOBuscar = "Departamentos Like '" & txtBuscar.Text & "'"
End If
If Option7.Value Then
' en el campo Resultados
sADOBuscar = "Resultados Like '" & txtBuscar.Text & "'"
End If
' Guardar la posici贸n anterior, por si no se halla lo buscado...
vBookmark = datRegistros.Recordset.Bookmark
'
If Siguiente = False Then
' Buscar desde el principio
datRegistros.Recordset.MoveFirst
datRegistros.Recordset.Find sADOBuscar
Else
' Busca a partir del registro actual
datRegistros.Recordset.Find sADOBuscar, 1
End If
' Devolver谩 un error si no se halla lo buscado
' aunque no siempre es as铆...
If Err.Number Or datRegistros.Recordset.BOF Or datRegistros.Recordset.EOF Then
Err.Clear
MsgBox "No existe el dato buscado o ya no hay m谩s datos que mostrar."
' Posicionar el recordset en la posici贸n guardada
datRegistros.Recordset.Bookmark = vBookmark
End If
End Sub
ES c贸digo lo utilizo para abrir la informaci贸n de calles.
Aqu铆 es donde se encuentra mi tabla que esta relaciona. No tengo problemas con esto.
Private Sub cmdAbrirFrmCalles_Click()
frmCalles.Show 1
'Set frmCalles.datRegistros.Recordset = frmCalles.datRegistros
End Sub
ES c贸digo lo utilizo para abrir la informaci贸n de DEptos.
Aqu铆 es donde se encuentra mi tabla que esta relaciona. No tengo problemas con esto.
Private Sub cmdAbrirFrmDeptos_Click()
frmDepartamentos.Show 1
End Sub
Private Sub cmdAbrirFrmEmpleados_Click()
frmEmpleados.Show 1
End Sub
Private Sub cmdAbrirFrmPromotores_Click()
frmPromotores.Show 1
End Sub
Private Sub cmdAbrirFrmResultados_Click()
frmResultados.Show 1
End Sub
Private Sub cmdAbrirFrmTramites_Click()
frmTiposTramites.Show 1
End Sub
Private Sub cmdAdd_Click()
On Error GoTo AddErr
' A帽adir un nuevo registro
datRegistros.Recordset.AddNew
Exit Sub
AddErr:
MsgBox Err.Description
End Sub
Private Sub cmdBuscar_Click()
' Buscar el primer registro que coincida con el dato buscado
Call Buscar
End Sub
Private Sub cmdBuscarSig_Click()
Buscar True
End Sub
Private Sub cmdDelete_Click()
On Error GoTo AddErr
' Eliminar un registro
datRegistros.Recordset.Delete
' Movemos al primer registro para que los cambios se hagan permanentes
' (tambi茅n podriamos haberlo movido al 煤ltimo registro)
If datRegistros.Recordset.EOF Then
datRegistros.Recordset.MoveLast
Else
datRegistros.Recordset.MoveNext
End If
Exit Sub
AddErr:
MsgBox Err.Description
'End If
'frmEliminarRegistro.Show
'On Error GoTo AddErr
'Dim intRespuesta As Integer
' Borrar el registro actual
' Se comprueba que haya alg煤n registro activo,
' para ello se comprueba que no hayamos pasado del principio o el final del Recordset
'
' Comprobar que hay registros, porque si no hay, dar谩 error
' If (datRegistros.Recordset.EOF Or datRegistros.Recordset.BOF) Then
' Avisar de que no hay registros
' datRegistros.Caption = "Ning煤n registro activo"
'Else
' Eliminar el registro actual
' intRespuesta = MsgBox("Est谩 seguro de eliminar este registro?", vbYesNo + vbQuestion + vbDefaultButton2, "Eliminar Registro")
' If intRespuesta = vbNo Then
'Exit Sub
'Else
'datRegistros.Recordset.Delete
' Movemos al primer registro para que los cambios se hagan permanentes
' (tambi茅n podriamos haberlo movido al 煤ltimo registro)
'If datRegistros.Recordset.EOF Then
'datRegistros.Recordset.MoveLast
'Else
'datRegistros.Recordset.MoveNext
'End If
'End If
'Exit Sub
'AddErr:
'MsgBox Err.Description
'End If
End Sub
Private Sub cmdfrmDictamenenesBuscar_Click()
frmBuscar02.Show
End Sub
Private Sub cmdfrmDictCerrar_Click()
frmDictamen.Hide
frmMenuPrincipal.Show
End Sub
///***** aqu铆 es donde tengo problemas...
y el error es el siguiente al hacer click en el boton de comando cmdGuardarDict :
**** Multiple-Step operation Generated errors.
Check each status value.
Private Sub cmdGuardarDict_Click()
On Error GoTo AddErr
' A帽adir un nuevo registro
datRegistros.Recordset.Update
Exit Sub
AddErr:
MsgBox Err.Description
End Sub
Private Sub cmdReconsideracion_Click()
frmDictamen.Hide
frmHistorial.Adodc1.RecordSource = "SELECT * FROM HistorialMtrios WHERE IdExpediente = " & frmDictamen.txtIDExpediente.Text
frmHistorial.Adodc1.Refresh
Set frmHistorial.dgridHistorial.DataSource = frmHistorial.Adodc1
frmHistorial.Show
End Sub
Private Sub cmdRefresh_Click()
On Error GoTo RefreshErr
datRegistros.Refresh
Exit Sub
RefreshErr:
MsgBox Err.Description
End Sub
Private Sub cmdUpdate_Click()
On Error GoTo UpdateErr
datRegistros.Recordset.UpdateBatch adAffectAll
Exit Sub
UpdateErr:
MsgBox Err.Description
End Sub
'Private Sub datRegistros_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
' Mostrar el ID del registro actual
' si se pasa del primero o del 煤ltimo, dar谩 error
'On Error Resume Next
' Mostrar el ID del registro actual usando el recordset pasado como par谩metro
'datRegistros.Caption = "Registro actual: " & pRecordset.AbsolutePosition
'datRegistros.Caption = "Registro actual: " & pRecordset.AbsolutePosition & " de " & pRecordset.RecordCount
' Si da error, indicarlo (20/Sep/99)
' If Err Or pRecordset.BOF Or pRecordset.EOF Then
' datRegistros.Caption = "Ning煤n registro activo"
' Habr铆a que moverlo a un registro con informaci贸n
' *** Dejarlo comentado ***
' para que el procedimiento de b煤squeda avise si no hay datos activos
'Adodc1.Recordset.MoveFirst
'End If
'
'Err = 0
'End Sub
'Private Sub datRegistros_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'datRegistros.Caption = "Registro actual: " & pRecordset.AbsolutePosition & " de " & pRecordset.RecordCount
'End Sub
'Private Sub datRegistros_WillMove(ByVal adReason As ADODB.EventReasonEnum, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'End Sub
'Private Sub Form_Activate()
' datRegistros.Recordset.MoveLast
' datRegistros.Recordset.MoveFirst
' datRegistros.Caption = datRegistros.Recordset.RecordCount
'datRegistros.Recordset.RecordCount
'End Sub
/***En esta parte me conecto a mi base de datos.
Private Sub Form_Load()
'
txtBuscar = ""
Option2.Value = True
'cmdDelete.Enabled = False
cmdUpdate.Enabled = False
'cmdRefresh.Enabled = False
frmDictamen.datRegistros.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:vbDictaminaMinutariodictamin.mdb;Persist Security Info=False"
frmHistorial.Adodc1.ConnectionString = frmDictamen.datRegistros.ConnectionString
frmDictamen.datRegistros.RecordSource = "Q_Minutarios"
frmDictamen.datRegistros.Refresh
' Asignar a cada uno de las cajas de texto el campo de la tabla
'txtIDExpediente.DataField = "IDExpediente"
txtClvExpediente.DataField = "Clv_Expediente"
txtCallesDict.DataField = "Calle"
End Sub
Private Sub txtBuscar_KeyPress(KeyAscii As Integer)
' Se buscar谩 s贸lo cuando pulsemos INTRO
'
' Comprobar si la tecla pulsada es Intro: vbKeyReturn o 13 que es lo mismo
If KeyAscii = vbKeyReturn Then
On Error Resume Next
' Esta asignaci贸n evita que suene un BEEP
KeyAscii = 0
'
Buscar
End If
End Sub
En este formulario de frmDepartamentos tengo este c贸digo que es donde inserto el IDDepartamentos a Consulta Minutarios para posterior mente guardar los cambios desde el Formularios frmDictamen.
Private Sub cmdfrmDeptosAceptar_Click()
frmDictamen.txtDeptosDict.Text = txtIDDeptos.Text
frmDictamen.datRegistros.Recordset.Fields("IDDepartamentos") = txtIDDeptos.Text
frmDepartamentos.Hide
frmDictamen.Show
End Sub
Orlando
13 de Mayo del 2004
Tienes que identificar que error es el que tienes, porque, si te graba en la tabla, debe ser algo que haces posteriormente..
Saludos.
Saludos.
Oskitar
13 de Mayo del 2004
ponte parte de ese codigo para chekearlo ya q si esta modificando no se cual sea el error. Quiza estas manejando los errores y te falta un exit sub o exit function , nose, pero si pones algo de tu codigo seria mas facil resolverlo
rafa
13 de Mayo del 2004
Seria bueno, que en caso de que te diera algun error, nos dijeras cual.
A parte del codigo como bien proponen
Un saludo
Rafa
A parte del codigo como bien proponen
Un saludo
Rafa
san
13 de Mayo del 2004
Hola... a煤n no he podido con este problema. Por favor escriban.