Corrupcion BD desde pc |
Responder |
Autor | |
arcangelcaos
Asiduo Unido: 15/Noviembre/2012 Localización: España Estado: Sin conexión Puntos: 245 |
Tema: Corrupcion BD desde pc Enviado: 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 |
|
Dabellaso
Asiduo Unido: 18/Noviembre/2012 Localización: España Estado: Sin conexión Puntos: 338 |
Enviado: 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 Editado por Dabellaso - 08/Mayo/2020 a las 13:06 |
|
El saber no ocupa lugar, sólo tiempo
|
|
arcangelcaos
Asiduo Unido: 15/Noviembre/2012 Localización: España Estado: Sin conexión Puntos: 245 |
Enviado: 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. |
|
pitxiku
Colaborador Unido: 27/Septiembre/2017 Localización: En mi casa Estado: Sin conexión Puntos: 1512 |
Enviado: 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 |
|
javier.mil
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 10/Agosto/2005 Localización: España Estado: Sin conexión Puntos: 4830 |
Enviado: 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 RSDeuda As DAO.RecordsetDim RSFincas 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. Editado por javier.mil - 09/Mayo/2020 a las 10:24 |
|
arcangelcaos
Asiduo Unido: 15/Noviembre/2012 Localización: España Estado: Sin conexión Puntos: 245 |
Enviado: 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. |
|
Responder | |
Tweet
|
Ir al foro | Permisos de foro Usted No puede publicar nuevos temas en este foro Usted No puede responder a temas en este foro Usted No puede borrar sus mensajes en este foro Usted No puede editar sus mensajes en este foro Usted No puede crear encuestas en este foro Usted No puede votar en encuestas en este foro |