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.

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

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.

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

san
13 de Mayo del 2004

Hola... aún no he podido con este problema. Por favor escriban.