Problema para encontrar un dato desde otra tabla y modificarlo
Estoy trabajando en una base de datos que registra información sobre actividades realizadas por personas, ésta se guarda en la tabla PEMAR y se genera un registro cada vez que se realiza la actividad, cada persona tiene un código asignado. Los códigos se guardan en la tabla TCodiPM, en esta tabla hay un campo (RPEMAR) en el que se guarda el número de veces que un código ingresa a la tabla de actividades. Las tablas se alimentan localmente, pero también reciben actualizaciones de datos por medios extraíbles como una USB. Antes de actualizar la tabla PEMAR, utilizó un archivo temporal llamado ITPEMAR y aquí comienza el problema. Para actualizar la tabla de códigos desde el archivo temporal utilizo el siguiente código, pero el resultado no es satisfactorio. Seguramente algo estoy haciendo mal, pero no logro encontrarlo. Agradecería su ayuda para resolver este problema.
Ricardo
Private Sub BusCodiPemar()
Dim VConCodi As Integer
Set dbsRU = CurrentDb
Set rsIPm = dbsRU.OpenRecordset("Select * From ITPEMAR Order by Codigo")
Set rsCPm = dbsRU.OpenRecordset("Select * From TCodiPM Order by Codigo")
Do Until rsCPm.EOF
VConPm = 0
VCodiEnco = rsCPm!Codigo
Do Until rsCPm!Codigo <> VCodiEnco
VConPm = rsCPm!RPemar
If rsCPm!Codigo = VCodiBus Then
VConPm = VConPm + 1
rsCPm.Edit
rsCPm!RPemar = VConPm
rsCPm.Update
rsCPm.MoveNext
If rsCPm!Codigo <> VCodiEnco Then rsCPm.MoveNext 'Exit Do
Else
VConCodi = DLookup("RPemar", "TCodiPM", "Codigo = '" & rsIPm!Codigo & "'")
If VConCodi = 0 Then
VConPm = 1
rsCPm.AddNew
rsCPm!Codigo = VCodiBus
rsCPm!RPemar = VConPm
rsCPm!FechaPI = rsIPm!Fecha
rsCPm.Update
End If
rsCPm.MoveNext
End If
Loop
Loop
rsCPm.Close
Set rsCPm = Nothing
End Sub
1 Respuesta
Seguí analizando el código después de descansar y lo resolví. Aquí va la solución por si a alguien le es útil.
Saludos
Private Sub APemar1()
'******************************
'Actualiza el campo Servi1 en TPEMAR
'******************************
Set dbs = CurrentDb
Set rst1 = dbs.OpenRecordset("Select * From ITPEMAR Order by Codigo")
rst1.MoveFirst
Do Until rst1.EOF
VCodiBus = rst1!Codigo
Call APemar2
If rst1!Codigo = VCodiBus Then
rst1.Edit
rst1!Servi1 = VConPm
rst1.Update
End If
rst1.MoveNext
If rst1.EOF Then Exit Do
Loop
rst1.Close
Set rst1 = Nothing
End Sub
Sub APemar2()
'******************************
'Actualiza el campo RPEMAR en CodiPM
'******************************
Set dbs = CurrentDb
Set rst2 = dbs.OpenRecordset("Select * From TCodiPM Order by Codigo")
Dim VCritBus As String
VCritBus = "[Codigo]=" & "'" & VCodiBus & "'"
If DCount("RPEMAR", "TCodiPM", VCritBus) > 0 Then 'Si lo encuentra
rst2.FindFirst VCritBus
VConPm = rst2!RPEMAR + 1
rst2.Edit
rst2!RPEMAR = VConPm
rst2.Update
Else 'Si no lo encuentra
VConPm = 1
rst2.AddNew
rst2!Codigo = VCodiBus
rst2!RPEMAR = VConPm
rst2!FechaPI = rst1!Fecha
rst2.Update
End If
End Sub
