Corrupcion BD desde pc
Impreso de: Foro de Access y VBA
Categoría: Access y VBA
Nombre del foro: Access y VBA
Descripción del foro: Foro de programacion en Access (Con código y sin código)
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=85257
Fecha de impresión: 16/Abril/2024 a las 23:04
Tema: Corrupcion BD desde pc
Publicado por: arcangelcaos
Asunto: Corrupcion BD desde pc
Fecha de publicación: 08/Mayo/2020 a las 11:26
Buenas a todos. Haber si me podéis echar una mano.
Esto este código en un programa ya hace meses, pero desde hace un par de semanas no para de bloquear el pc corromper la BD backend.
Lo que hace este código es tengo un subfor con datos de fincas, trabajos e importes, y otro subform con trabajadores, pues al darle al botón que ejecuta el código añade tantas líneas por trabajador como tareas haya y reparte el dinero en todos.
Fechabloqueo = DLookup("FechaBloqueo", "FechaBloqueo")
If Me.Fecha <= Fechabloqueo Then
MsgBox "No se puede modificar el parte, esta bloqueado porque las nominas estan realizadas"
Me.Form.Undo
DoCmd.CancelEvent
Exit Sub
End If
aux = Nz(Forms!F_PartesTrabajoPrin!F_PartesTrabajoSub!TotalImporte, 0)
If aux > 0 Then
MsgBox "Ya se ya repartido el parte, no se puede volver a repartir borre todos los trabajadores y vuelva a intentarlo", vbExclamation + vbOKOnly, "Imposible"
DoCmd.CancelEvent
Exit Sub
End If
respuesta = MsgBox("Se va a proceder a repartir entre los trabajadores, ¿Estas seguro?", vbQuestion + vbYesNo, "REPARTIR")
If respuesta = vbYes Then
Dim RSTrabajadores As Recordset
Dim RSFincas As Recordset
Dim sql As String
Dim Importe1 As Double
Dim Cantidad1 As Double
Dim Precio1 As Double
Set db = CurrentDb ' selecciono todos los trabajadores
sql = "SELECT IdParteTrabajo, IdParteTrabajoPrin, IdTrabajador, IdTarea, IdEmpresaTrabajador FROM PartesTrabajoTrabajadores WHERE IdParteTrabajoPrin = " & Me.IdTarea & ""
Set RSTrabajadores = db.OpenRecordset(sql)
If RSTrabajadores.RecordCount > 0 Then
RSTrabajadores.MoveLast
CuentaTrabajadores = RSTrabajadores.RecordCount
sql = "SELECT Fecha, Finca, Fase, Semana, SemanaTraz, Articulo, Cantidad, Precio, Importe, Campaña, IdEmpresaFinca FROM PartesTrabajoSub WHERE IdTareaPrin = " & Me.IdTarea & ""
Set RSFincas = db.OpenRecordset(sql)
If RSFincas.RecordCount > 0 Then
RSFincas.MoveLast
CuentaFincas = RSFincas.RecordCount
RSFincas.MoveFirst ' hacemos el primer reparto, y si hay más, lo que se hara será añadir registros
Importe1 = RSFincas![Importe] / CuentaTrabajadores
Cantidad1 = RSFincas![Cantidad] / CuentaTrabajadores
Precio1 = RSFincas![Precio]
RSTrabajadores.MoveFirst
Do While Not RSTrabajadores.EOF
linea = RSTrabajadores![IdParteTrabajo]
db.Execute "UPDATE PartesTrabajoTrabajadores SET [Precio] = '" & Precio1 & "', [Importe] = '" & Importe1 & "', [Cantidad] = '" & Cantidad1 & "', [Fecha] = #" & Format(RSFincas![Fecha], "yy/mm/dd") & "#, [IdTarea] = " & RSFincas![Articulo] & ", [IdFinca] =" & RSFincas![Finca] & ",[IdCampaña]= " & RSFincas![Campaña] & ",[IdFase]= " & Nz(RSFincas![Fase], 0) & ", [IdSemana] = " & Nz(RSFincas![Semana], 0) & ", [IdEmpresaSemana] = " & RSFincas![IdEmpresaFinca] & ", [IdSemanaTraza] = " & Nz(RSFincas![SemanaTraz], 0) & " WHERE [IdParteTrabajo] = " & linea & " "
FechaFin = DateSerial(Year(Me.Fecha), Month(Me.Fecha) + 1, 1 - 1)
Dim RSDeuda As Recordset
FechaI = DateSerial(Year(Me.Fecha), Month(Me.Fecha), 1)
Set db = CurrentDb
sql = "SELECT IdDeuda, Trabajador, Fecha, IdFactura, IdEmpresa FROM Deudas" _
& " WHERE Trabajador = " & RSTrabajadores![IdTrabajador] & " And IdFactura = " & 0 & " And Fecha = #" & Format(FechaFin, "yy/mm/dd") & "# AND IdEmpresa = " & RSTrabajadores![IdEmpresaTrabajador] & ""
Set RSDeuda = db.OpenRecordset(sql)
ImporteDeuda = Nz(DSum("Importe", "PartesTrabajoTrabajadores", "IdTrabajador = " & RSTrabajadores![IdTrabajador] & " AND IdEmpresaTrabajador = " & RSTrabajadores![IdEmpresaTrabajador] & " AND Fecha >= #" & Format(FechaI, "yy/mm/dd") & "# AND Fecha <= #" & Format(FechaFin, "yy/mm/dd") & " # "), 0)
DoCmd.SetWarnings False
If RSDeuda.RecordCount > 0 Then
CurrentDb.Execute "UPDATE Deudas SET Importe = " & Replace(ImporteDeuda, ",", ".") & " WHERE IdFactura = " & 0 & " AND IdDeuda = " & RSDeuda![IdDeuda] & ""
Else
DoCmd.RunSQL "INSERT INTO Deudas (Trabajador, Concepto, Fecha, IdFactura, Importe, IdEmpresa) VALUES (" & RSTrabajadores![IdTrabajador] & ", '" & "Nomina de " & Format(FechaFin, "mmmm") & "' , #" & Format(FechaFin, "yy/mm/dd") & "#, " & 0 & ", " & Replace(ImporteDeuda, ",", ".") & ", " & RSTrabajadores![IdEmpresaTrabajador] & " )"
End If
DoCmd.SetWarnings True
RSTrabajadores.MoveNext
Loop
RSFincas.MoveNext
Do While Not RSFincas.EOF ' aqui si hay más fincas, se añadiran más registros
Importe1 = RSFincas![Importe] / CuentaTrabajadores
Cantidad1 = RSFincas![Cantidad] / CuentaTrabajadores
Precio1 = RSFincas![Precio]
RSTrabajadores.MoveFirst
Do While Not RSTrabajadores.EOF
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO PartesTrabajoTrabajadores (IdParteTrabajoPrin, IdTrabajador, IdEmpresaTrabajador) VALUES (" & Me.IdTarea & ", " & RSTrabajadores![IdTrabajador] & " , " & RSTrabajadores![IdEmpresaTrabajador] & " )"
DoCmd.SetWarnings True
linea = DMax("IdParteTrabajo", "PartesTrabajoTrabajadores")
db.Execute "UPDATE PartesTrabajoTrabajadores SET [Precio] = '" & Precio1 & "', [Importe] = '" & Importe1 & "', [Cantidad] = '" & Cantidad1 & "', [Fecha] = #" & Format(RSFincas![Fecha], "yy/mm/dd") & "#, [IdTarea] = " & RSFincas![Articulo] & ", [IdFinca] =" & RSFincas![Finca] & ",[IdCampaña]= " & RSFincas![Campaña] & ",[IdFase]= " & Nz(RSFincas![Fase], 0) & ", [IdSemana] = " & Nz(RSFincas![Semana], 0) & ", [IdEmpresaSemana] = " & RSFincas![IdEmpresaFinca] & ", [IdSemanaTraza] = " & Nz(RSFincas![SemanaTraz], 0) & " WHERE [IdParteTrabajo] = " & linea & " "
FechaFin = DateSerial(Year(Me.Fecha), Month(Me.Fecha) + 1, 1 - 1)
FechaI = DateSerial(Year(Me.Fecha), Month(Me.Fecha), 1)
Set db = CurrentDb
sql = "SELECT IdDeuda, Trabajador, Fecha, IdFactura, IdEmpresa FROM Deudas" _
& " WHERE Trabajador = " & RSTrabajadores![IdTrabajador] & " And IdFactura = " & 0 & " And Fecha = #" & Format(FechaFin, "yy/mm/dd") & "# AND IdEmpresa = " & RSTrabajadores![IdEmpresaTrabajador] & ""
Set RSDeuda = db.OpenRecordset(sql)
ImporteDeuda = Nz(DSum("Importe", "PartesTrabajoTrabajadores", "IdTrabajador = " & RSTrabajadores![IdTrabajador] & " AND IdEmpresaTrabajador = " & RSTrabajadores![IdEmpresaTrabajador] & " AND Fecha >= #" & Format(FechaI, "yy/mm/dd") & "# AND Fecha <= #" & Format(FechaFin, "yy/mm/dd") & " # "), 0)
DoCmd.SetWarnings False
If RSDeuda.RecordCount > 0 Then
CurrentDb.Execute "UPDATE Deudas SET Importe = " & Replace(ImporteDeuda, ",", ".") & " WHERE IdFactura = " & 0 & " AND IdDeuda = " & RSDeuda![IdDeuda] & ""
Else
DoCmd.RunSQL "INSERT INTO Deudas (Trabajador, Concepto, Fecha, IdFactura, Importe, IdEmpresa) VALUES (" & RSTrabajadores![IdTrabajador] & ", '" & "Nomina de " & Format(FechaFin, "mmmm") & "' , #" & Format(FechaFin, "yy/mm/dd") & "#, " & 0 & ", " & Replace(ImporteDeuda, ",", ".") & ", " & RSTrabajadores![IdEmpresaTrabajador] & " )"
End If
DoCmd.SetWarnings True
RSTrabajadores.MoveNext
Loop
RSFincas.MoveNext
Loop
End If ' el de las fincas
End If ' el de los trabajadores
End If ' el de la respuesta
db.Close
Me.Refresh
|
Respuestas:
Publicado por: Dabellaso
Fecha de publicación: 08/Mayo/2020 a las 12:56
|
Hola Hace poco, pitxiku solucionó un problema que me surgió debido a una mala declaración de una las variales. Antes de aplicar la solución que me propuso, en mi caso la Db también se bloqueaba, e incluso, a veces, bloqueaba Access. Tras aplicar su solución, demás de resolver mi problema, desaparecieron todos los demás, ni la db, ni Access se han vuelto a bloquear
Creo que quizás te pueda estar pasando lo mismo, sin entrar en el código que supongo funcionará, veo que no cierras los recordset que utilizas, ni liberas estableciendo ninguno de los objetos utilizados a Nothing.
Creo que al final, faltan cosas como: RSTrabajadores.Close Set RSTrabajadores =Nothing RSFincas.Close Set RSFincas =Nothing Set db = Nothing
Prueba a hacerlo y nos cuentas a ver que tal.
Pd. También veo muchas variables normales sin declarar, no creo que sean la causa del problema, pero si me parece buena práctica declararlas (respuesta, CuentaTrabajadores, CuentaFincas, ImporteDeuda,... y bastantes más)
Saludos
-------------
El saber no ocupa lugar, sólo tiempo
|
Publicado por: arcangelcaos
Fecha de publicación: 08/Mayo/2020 a las 18:19
Hola, gracias, pero he probado con eso y no es
Además, ha estado casi 1 año funcionando bien, y lleva 2 semana que no. Va super lento, que de tardar 5 seg en calcular, tarda 6minutos, cronometrado, y muchas veces corrompe la bd de datos, no la de formularios.
La cosa es que en otro pc funciona bien, es solo en 2, en los otros 3 va bien.
He desinstalado office y vuelvo a instalar, y nada. Incluso es el mismo fichero, no es una copia, quizás sea alguna actualización de Windows, o alguna librería, ni idea.
|
Publicado por: pitxiku
Fecha de publicación: 08/Mayo/2020 a las 19:56
A ver si esto que posteó el maestro Nekkito en su foto te sirve:
- https://nksvaccessolutions.com/Foro/viewtopic.php?f=7&t=1739
|
Publicado por: javier.mil
Fecha de publicación: 09/Mayo/2020 a las 10:23
|
Mas cosas .......
Cambia la declaración del recordset
Donde pone Dim RSTrabajadores As Recordset
Dim RSFincas As Recordset Dim RSDeuda As Recordset
Deberia poner Dim RSTrabajadores As DAO.Recordset
Dim RSFincas As DAO.Recordset Dim RSDeuda As DAO.Recordset
Otra opción mas es importar todos los objetos a una base nueva , depurar y compactar la base y solo seleccionar las referencias / librerías mínimas para que funcione el código.
-------------
https://www.accessdemo.info" rel="nofollow - https://www.accessdemo.info
|
Publicado por: arcangelcaos
Fecha de publicación: 20/Mayo/2020 a las 16:29
Gracias.
Esto medio que lo ha solucionado.
Ya no me corrompe la backend, pero sigue siendo muy lenta ese pc.
En los otros va bien.
Ya no se que mirar más.
Podéis cerrarlo si queréis.
|
|