Vinculación de tablas de bases de datos: acceso, VBA
Tengo un procedimiento que vuelve a vincular todas las tablas de una base de datos en función de si son o no una tabla vinculada. Actualmente, esto está configurado para ejecutarse automáticamente como se establece dentro de una macro AutoExec que llama a la función.
El código funciona peroSolo si cierro la base de datos y la vuelvo a abrir.. Sé que esto se debe a que es necesario hacer esto para que los nuevos enlaces surtan efecto, pero ¿hay alguna manera en torno a esto? O, en su defecto, ¿sería mejor hacer que el código VBA cierre la base de datos y la vuelva a abrir?
Gracias de antemano por los comentarios
PD Aquí está el código, por si tienes curiosidad:
'*******************************************************************
'* This module refreshes the links to any linked tables *
'*******************************************************************
'Procedure to relink tables from the Common Access Database
Public Function RefreshTableLinks() As String
On Error GoTo ErrHandler
Dim strEnvironment As String
strEnvironment = GetEnvironment
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strCon As String
Dim strBackEnd As String
Dim strMsg As String
Dim intErrorCount As Integer
Set db = CurrentDb
'Loop through the TableDefs Collection.
For Each tdf In db.TableDefs
'Verify the table is a linked table.
If Left$(tdf.Connect, 10) = ";DATABASE=" Then
'Get the existing Connection String.
strCon = Nz(tdf.Connect, "")
'Get the name of the back-end database using String Functions.
strBackEnd = Right$(strCon, (Len(strCon) - (InStrRev(strCon, "\") - 1)))
'Debug.Print strBackEnd
'Verify we have a value for the back-end
If Len(strBackEnd & "") > 0 Then
'Set a reference to the TableDef Object.
Set tdf = db.TableDefs(tdf.Name)
If strBackEnd = "\Common Shares_Data.mdb" Or strBackEnd = "\Adverse Events.mdb" Then
'Build the new Connection Property Value - below needs to be changed to a constant
tdf.Connect = ";DATABASE=" & strEnvironment & strBackEnd
Else
tdf.Connect = ";DATABASE=" & CurrentProject.Path & strBackEnd
End If
'Refresh the table links
tdf.RefreshLink
End If
End If
Next tdf
ErrHandler:
If Err.Number <> 0 Then
'Create a message box with the error number and description
MsgBox ("Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & vbCrLf)
End If
End Function
EDITAR
A partir de los comentarios de Gords he añadido la macroAutoExec
Método para llamar al código de abajo. ¿Alguien ve algún problema con esto?
Action: RunCode
Function Name: RefreshTableLinks()