** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - ReVincularTablas
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoReVincularTablas

 Responder Responder
Autor
Mensaje
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 1826
Enlace directo a este mensaje Tema: ReVincularTablas
    Enviado: 18/Febrero/2019 a las 19:40
Estoy intentando modificar esta funcion creo que de Buho, para pasarle la ruta completa para el Database y la tabla que quiero que revincule, aqui es donde me atasco, por mucho que pruebo no me sale, no acabo de ver claramente el funcionamiento de la funcion. Quizas no se pueda con esta funcion, no lo veo....

La funcion la lanzo desde un bucle que me da los datos de cada tabla,  directorio complero(Database), la contraseña y la tabla.
Cada tabla puede tener un Database diferente de hay el bucle.

Function ReVinculaTablas(RutaFichero As String, varContraseña As String, varTabla As String) As Boolean
'MsgBox RutaFichero                                                      'Necesito dar nombre a tabla!!!!!!!????
On Error GoTo Err_ControlErrorFuncion
        Dim Contador As Integer
        Dim objAcObj As AccessObject
        Dim objCurData As CurrentData
        Dim DBSS As Database
        Set objCurData = Application.CurrentData
        Dim Tabla As TableDef
        Set DBSS = CurrentDb()
         For Each objAcObj In objCurData.AllTables
          Set Tabla = DBSS.TableDefs(objAcObj.Name)   'Necesito dar nombre a tabla!!!!!!!????
         
          If Tabla.Attributes And dbSystemObject Then
          'en este if quito las tablas del sistema y todas aquellas que sean locales
          'que obviamente no son necesarias vincular.
          'ya que la MDB puede tener tablas locales (Que obviamente no son precisas vincular).
          'y tener tablas vinculadas, que son las que se recogerían
          'en el ELSE siguiente.

          Else
           Contador = Contador + 1
           'If IsNull(Forms!frmvincula.Password) Then 'No tiene clave
                'Tabla.Connect = ";DATABASE=" & RutaFichero & ";"
            'Else

                Tabla.Connect = ";DATABASE=" & RutaFichero & ";PWD=" & varContraseña & ";"
               
           'End If
           Tabla.RefreshLink
           If Contador = 1 Then
            'aqui meto la sugerencia de Juan M AFan de Ribera y no es otra
            'que para acelerar el proceso de revinculacion en entornos de red
            'se abre el recordset de la primera tabla vinculada y no se cierra hasta
            'el final, cuando ya se han revinculado todas.
            'De esta forma, dicen, se acelera el proceso de revinculacion.
            'El comentario que me hacía Juan era:
            'Pues bien, tocando el tema de revincular tablas, sobre todo si es por
            'código, me consta que si la base de datos con los datos (backend) está en
            'una red, es más que probable que el proceso sea lento o muy lento. Para
            'incrementar la velocidad de esa revinculación se puede hacer lo siguiente:

            'Una vez se ha conectado con la base de datos origen y se ha vinculado la
            'primera tabla, se ha de abrir un recordset de esa primera tabla y seguir con
            'el proceso de revinculación. Cuando se haya acabado de revincular, ya se
            'puede cerrar el recordset. Podéis encontrar más información sobre este
            'proceso y muchas otras cosas interesantes en la página de nuestro amigo Tony
            'Towes (alguno de por aquí creo que le ya le conoce)

             'http://www.granite.ab.ca/access/splitapp.htm

            'yo hice la prueba en el trabajo y la diferencia de tiempo en una bd con unas
            '30 tablas vinculadas fue de casi 2 minutos.


            Dim Rst As DAO.Recordset
            Set Rst = CurrentDb.OpenRecordset(Tabla.Name)
           End If
          End If
         Next objAcObj
         If Contador <> 0 Then
        
          'cierro el recordset de la primera tabla
          'que aceleraba el proceso de revinculación

          Rst.Close
          Set Rst = Nothing
         End If
         ReVinculaTablas = True
         Exit Function
      
Exit_ControlErrorFuncion:
 Exit Function
Err_ControlErrorFuncion:
 If Err.Number = 3078 Or Err.Number = 3011 Then
   MsgBox "La Mdb escogida, parece no ser la que tiene las tablas vinculadas -> " & Chr(13) & Chr(10) & Err.Description, vbCritical + vbOKOnly, "El Búho Informa: Error de Datos"
 Else
  MsgBox "Se ha producido el Error Nº: " & Err.Number & " ." & Err.Description, vbCritical + vbOKOnly, "Error de Datos"
 End If
 ReVinculaTablas = False
 Resume Exit_ControlErrorFuncion
End Function


Editado por rokoko - 18/Febrero/2019 a las 19:40
Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 11778
Enlace directo a este mensaje Enviado: 18/Febrero/2019 a las 22:36
Un poco más corta, sin comentarios y sin el truquillo de Happy. Escrita al vuelo en base a una un poco más compleja que utilizo. En teoría funciona...


Function Revincula(strPathDatabase As String, strNombreTabla As String, Optional strPassword As String = "") As Boolean
    On Error GoTo ErrorHandler
    
    Dim strCadenaConexion   As String
    Dim tblAct              As TableDef
    
    Revincula = False
    
    strCadenaConexion = ";DATABASE=" & strPathDatabase & IIf(strPassword <> "", ";PWD=" & strPassword & ";", "")
    For Each tblAct In CurrentDb.TableDefs
        If tblAct.Name = strNombreTabla Then
            If tblAct.Connect <> "" Then
                If tblAct.Connect <> strCadenaConexion Then
                    tblAct.Connect = strCadenaConexion
                    tblAct.RefreshLink
                End If
            End If
            Revincula = True
            Exit Function
        Else
            ' nada
        End If
    Next
    
ExitProcedure:
    Exit Function
ErrorHandler:
    Select Case Err.Number
        Case 3011
            MsgBox "El nombre de la tabla " & strNombreTabla & " no se ha encontrado en la base de datos origen", vbCritical, "AVISO"
            Resume ExitProcedure
        Case 7874
            ' Objeto no existe
            Resume Next
        Case Else
            MsgBox Err.Number & " - " & Err.Description
            Resume ExitProcedure
    End Select
End Function
Xavi, un minyó de Terrassa

Mi web
Arriba
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 1826
Enlace directo a este mensaje Enviado: 19/Febrero/2019 a las 01:39
A funcionado perfectamente, graciasTongue
Se puede cerrar

Saludos

Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable