Ahora copie un modulo de otro programa que hice y lo intente implementar exactamente a mi sistema. He corregido los erroes que me ha estado arrojando el sistemita y ahroa llegue a una pared que llevo ya casi 2 dias sin poder resolver. Error que me esta matando y el cual he googleado como loco sin respuesta aparente.
Me bota siempre el mismo error, haciendo referencia a la base de datos de mi proyecto del cual lo saque "La direccion de la base X://Xxxx.mdb" no existe o no se encuentra, aun cuando le pongo al inicio de cada metodo el set DBS = current database, entonces no entiendo porque sigue apuntando a la base del otro proyecto.
Aqui pongo un fragmento del codigo donde me tira el error...
Código:
Cualquier tipo de ayuda es bienvenida.Private Sub ACTUALIZAR_Click() On Error GoTo Err_ACTUALIZAR_Click Dim mensaje, respuesta As String If IsNull(FECHAINI) Or IsNull(FECFINAUX) Then MsgBox "DATOS INCOMPLETOS. INTRODUCIR FECHAS" DoCmd.GoToControl "FECHAINI" Else If FECHAINI > FECFINAUX Then MsgBox "LA FECHA FINAL DEL MES AUXILIAR DEBE SER MAYOR " _ & "O IGUAL QUE LA FECHA INICIAL A DEL EJERCICIO" DoCmd.GoToControl "FECHAINI" Else mensaje = "Desea continuar con la actualizacion" respuesta = MsgBox(mensaje, vbOKCancel, "ACTUALIZAR") If respuesta = vbOK Then Borra_AUXILIARVWM Actualiza_DRT002 Actualiza_DRT002_VXS 'Imprimir_reportes Exit_ACTUALIZAR_Click: Exit Sub Err_ACTUALIZAR_Click: MsgBox Err.Description Resume Exit_ACTUALIZAR_Click End If End If End If End Sub Private Sub Borra_AUXILIARVWM() Dim DBS As Database Dim CADSQL As String On Error GoTo Err_Borra_AUXILIARVWM_Click Set DBS = CurrentDb CADSQL = "DELETE FROM AUXILIARVWM" DBS.Execute CADSQL Exit_Borra_AUXILIARVWM_Click: Exit Sub Err_Borra_AUXILIARVWM_Click: MsgBox Err.Description Resume Exit_Borra_AUXILIARVWM_Click End Sub Private Sub Actualiza_DRT002() Dim DBS As Database Dim strSql As String Set DBS = CurrentDb strSql = "SELECT SNC, SNOMI, SNOM, REFERENCIA, SCDEU, SPP, " _ & "SFECH, A_PARTIR, SFAP, SPAP, SALDO_ACT, COMP " _ & "FROM DRT002 ORDER BY SFECH, SNCH" Set qdf = DBS.OpenRecordset(strSql) If (qdf.EOF) Then MsgBox "No hay elementos para esta página del Panel de control" Else While (Not (qdf.EOF)) If IsNull(qdf!A_PARTIR) Then 'MsgBox "El empleado " & qdf!SNOM & " no tienen fecha A_PARTIR en la tabla DRT002" Else If (qdf!SALDO_ACT <> 0) And (qdf!COMP = "I") Then Select Case (qdf!SFAP) 'Pagos mensuales Case 1 If (qdf!A_PARTIR >= FECHAINI) _ And (qdf!A_PARTIR <= FECFINAUX) _ And (qdf!SPAP <> 0) Then saldo = qdf!SALDO_ACT - qdf!SPP FORMAPAG = qdf!SPAP - 1 Inserta_AUXILIARVWM Guarda_DRT002 End If 'Pago único Case 2 If (qdf!A_PARTIR >= FECINIAUX) And (qdf!A_PARTIR <= FECFINAUX) Then saldo = qdf!SALDO_ACT - qdf!SPP Else saldo = qdf!SALDO_ACT End If Inserta_AUXILIARVWM If (qdf!A_PARTIR >= FECHAINI) _ And (qdf!A_PARTIR <= FECFINAUX) _ And (qdf!SPAP <> 0) Then saldo = qdf!SALDO_ACT - qdf!SPP FORMAPAG = qdf!SPAP - 1 Guarda_DRT002 End If End Select End If End If qdf.MoveNext Wend End If qdf.Close Private Sub Inserta_AUXILIARVWM() Dim DBS As Database Dim CADSQL As String On Error GoTo Err_Inserta_AUXILIARVWM_Click Set DBS = CurrentDb CADSQL = "INSERT INTO AUXILIARVWM " _ & "(SNOMI,NUM_CTRL, NOMBRE, REFERENCIA, SDO_DEUDOR, PAGOS_DE, " _ & " FECHA_PRES, FECHA_APAR, SDO_ACTUAL, FORMA, LIQUIDAR)" _ & " VALUES('" & qdf!SNOMI & "'," & qdf!SNC & ",'" & qdf!SNOM & "','" _ & qdf!REFERENCIA & "'," & qdf!SCDEU & "," & qdf!SPP _ & ",'" & qdf!SFECH & "','" & qdf!A_PARTIR & "'," & saldo _ & "," & qdf!SFAP & ",'" & qdf!A_PARTIR & "')" DBS.Execute CADSQL Exit_Inserta_AUXILIARVWM_Click: Exit Sub Err_Inserta_AUXILIARVWM_Click: MsgBox CADSQL MsgBox Err.Description Resume Exit_Inserta_AUXILIARVWM_Click End Sub Private Sub Guarda_DRT002() Dim DBS As Database Dim CADSQL As String 'On Error GoTo Err_Guarda_drt002 Set DBS = CurrentDb CADSQL = "UPDATE DRT002 " _ & "SET SALDO_ACT =" & saldo & ", " _ & "SPAP = " & FORMAPAG & " WHERE " _ & "COMP = '" & qdf!COMP & "' And " _ & "SNC = " & qdf!SNC & " And " _ & "REFERENCIA = '" & qdf!REFERENCIA & "'" DBS.Execute CADSQL Exit_Guarda_DRT002: Exit Sub Err_Guarda_DRT002: MsgBox Err.Description Resume Exit_Guarda_DRT002 End Sub
Muchas gracias!