Ver Mensaje Individual
  #1 (permalink)  
Antiguo 23/01/2012, 12:32
Yoso
 
Fecha de Ingreso: agosto-2011
Ubicación: Xalapa
Mensajes: 10
Antigüedad: 12 años, 8 meses
Puntos: 0
Conectando a otra base?

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!