Pues bien, tengo un sistemita medio choncho en access que he estado elaborando sin problema alguno.
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:
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
Cualquier tipo de ayuda es bienvenida.
Muchas gracias!