Access - revincular tablas desde bases de datos

dbs.TableDefs(i).Connect = ";DATABASE=" & strBDRemota & ";PWD=Mipasswordr" & ";"

Option Compare Database

Option Explicit

Private Sub cboAño_Click()

End Sub        ' cboAño_Click

Private Sub Form_Load()

Dim strBaseDatos As String

Me.lstAños.RowSource = ""

' establezco el directorio activo

ChDir "D:\RevinculandoTablas\"

' recorro en un bucle las bases de datos "*Datos*" del directorio

strBaseDatos = Dir("D:\RevinculandoTablas\*.mdb")

Do While Not strBaseDatos = ""

' selecciono los archivos que cumplan las condiciones necesarias

If InStr(strBaseDatos, "48") <> 0 And InStr(strBaseDatos, "Datos") <> 0 Then

' inserto en el cuadro combinado los años y correspondientes bases de datos (en columna oculta)

Me.lstAños.AddItem "Año " & Mid(strBaseDatos, InStr(strBaseDatos, ".") - 4, 4) & ";" & strBaseDatos

End If

strBaseDatos = Dir

Loop

 'selecciono el año actualmente vinculado, para ello lo extraigo de la actual ruta

strBaseDatos = CurrentDb.TableDefs(0).Connect

Me.lstAños = "Año " & Mid(strBaseDatos, InStr(strBaseDatos, ".") - 4, 4)

AjustarTamaño Me

'DoCmd.OpenForm "frmINFO", , , , , acDialog

End Sub ' Form_Load

Private Sub lstAños_AfterUpdate()

' al seleccionar el año, revinculo las tablas.

ReVinculaTablas Me.lstAños.Column(1)

End Sub        ' lstAños_AfterUpdate

Option Compare Database

Option Explicit

'*******************************************************************************

'* AjustarTamaño

'* Ajusta el tamaño del formulario pasado como parámetro

'* Argumentos: frmFormulario => Formulario llamante

'* uso: AjustarTamaño Me

'* ESH 06/03/05 12:25

'* ESH 08/10/05 19:50 incluyo el alto de las distintas secciones

'* ESH 08/03/06 18:15 me aseguro de ajustar la altura solo en los formularios

'*                    simples

'*******************************************************************************

Public Sub AjustarTamaño(frmFormulario As Form)

Dim i As Long

On Error GoTo AjustarTamaño_TratamientoErrores

' ajusto el ancho del formulario teniendo en cuenta si tiene o no selector de registros

If Not frmFormulario.RecordSelectors Then

    frmFormulario.InsideWidth = frmFormulario.Width

Else

    frmFormulario.InsideWidth = frmFormulario.Width + 250

End If

' si se abre en vista formulario simple

If frmFormulario.DefaultView = 0 Then

   ' ajusto el alto incluyendo las distintas secciones, encabezado, pie, grupos...

   ' como no sé el número de secciones del formulario, me salgo al producirse un error

   frmFormulario.InsideHeight = 0

   For i = 0 To 100

      frmFormulario.InsideHeight = frmFormulario.InsideHeight + frmFormulario.Section(i).Height

   Next

End If

AjustarTamaño_Salir:

   DoCmd.Restore

   On Error GoTo 0

   Exit Sub

AjustarTamaño_TratamientoErrores:

   If Not Err = 2462 Then  ' "El número de sección que introdujo no es válido."

      MsgBox "Error " & Err.Number & " en proc.: AjustarTamaño de Módulo: Módulo1 (" & Err.Description & ")"

   End If

   Resume AjustarTamaño_Salir

End Sub         ' AjustarTamaño

'*******************************************************************************

'* ReVinculaTablas

'* recorro las distintas tablas de la base de datos revinculandolas a la ruta

'* indicada

'* Argumentos: strBDRemota => ruta de la base de datos remota

'* uso: ReVinculaTablas "48-DatosAño2005.mdb"

'* ESH 30/04/06 12:16

'*******************************************************************************

Public Function ReVinculaTablas(strBDRemota As String)

Dim i As Long, _

    dbs As DAO.Database

On Error GoTo ReVinculaTablas_TratamientoErrores

Set dbs = CurrentDb

For i = 0 To dbs.TableDefs.Count - 1

   ' si dbs.TableDefs(i).connect no está vacio, es por que se trata de una tabla vinculada

   If (dbs.TableDefs(i).Connect <> "") Then

      ' así pues asigno la "nueva" ruta a la tabla vinculada

      dbs.TableDefs(i).Connect = ";DATABASE=" & CurrentProject.Path & "\" & strBDRemota & ";"

      dbs.TableDefs(i).RefreshLink

   End If

Next i

ReVinculaTablas_Salir:

Set dbs = Nothing

On Error GoTo 0

Exit Function

ReVinculaTablas_TratamientoErrores:

If Err.Number = 3024 Or Err.Number = 3078 Or Err.Number = 3011 Then

   MsgBox "La base de datos " & strBDRemota & vbCrLf & CurrentProject.Path, vbCritical + vbOKOnly, "ATENCION"

Else

   MsgBox "Error " & Err.Number & " en proc. ReVinculaTablas de Módulo mdlGeneral (" & Err.Description & ")", vbOKOnly + vbCritical

End If

GoTo ReVinculaTablas_Salir

End Function    ' ReVinculaTablas

dbs.TableDefs(i).Connect = ";DATABASE=" & CurrentProject.Path & "\" & strBDRemota & ";PWD=Mipasswordr" & ";"