Access tiene la posibilidad de crear vínculos o enlaces externos a otras fuentes de datos. Hasta aquí todo bien. El problema surge cuando movemos la base de datos a otra ubicación, porque Access guarda la ruta absoluta a las fuentes externas de datos. Para unas situaciones está bien y para otras nos hace la vida imposible sin avisar.
A continuación os muestro un código de VBA para insertar en una macro de Access para que lo podamos ejecutar cuando queramos o automáticamente cuando abramos la base de datos:
Option Compare Database
Option ExplicitPublic Function UpdateLinks() As Boolean
Dim cmdSQL As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim Database As String
Dim DirDatabase As String
Dim RefName As String
Dim sName As String
Dim sLinkBegin As String
Dim sLinkEnd As String
Dim ID As Long
Dim updateRef As Boolean
Set db = CurrentDb()
Database = db.Name
DirDatabase = GetPath(CurrentDb().Name)
cmdSQL = «SELECT * FROM MSysObjects WHERE Type = 6″
Set rs = db.OpenRecordset(cmdSQL, dbOpenSnapshot)
While Not rs.EOF
ID = rs(«ID»)
sLinkBegin = rs(«Database»)
sName = rs(«Name»)
RefName = Filename(sLinkBegin)
sLinkEnd = DirDatabase & RefName
updateRef = False
If (Not FileExists(sLinkBegin)) And FileExists(sLinkEnd) Then
updateRef = True
End If
If sLinkBegin <> sLinkEnd And FileExists(sLinkBegin) And FileExists(sLinkEnd) Then
If VbMsgBoxResult.vbOK = MsgBox(«Actualizar referencia » & sLinkBegin & » por la referencia » & sLinkEnd & «?», vbOKCancel, «Actualizar referencias«) Then
updateRef = True
End If
End If
If updateRef Then
‘Herramientas> Referencias…
‘Añadir: Microsoft ADO Ext 2.5 (o posterior) for DDL and Security.
‘objCat.Tables(sName).Type = «LINK»
Dim objCat As New ADOX.Catalog ‘Define the ADOX Catalog Object
objCat.ActiveConnection = CurrentProject.Connection
objCat.Tables(sName).Properties(«Jet OLEDB:Link Datasource«) = sLinkEnd
End If
rs.MoveNext
Wend
rs.Close
db.Close
End FunctionPrivate Function GetPath(path_and_filename As String) As String
Dim path As String
Dim posicionPath As Integer
posicionPath = InStrRev(path_and_filename, «\»)
path = Left(path_and_filename, posicionPath)
GetPath = path
End FunctionPrivate Function FileExists(Filename As String) As Boolean
FileExists = (Dir(Filename) > «»)
End FunctionPrivate Function Filename(ByVal strPath As String) As String
If Right$(strPath, 1) <> «\» And Len(strPath) > 0 Then
Filename = Filename(Left$(strPath, Len(strPath) – 1)) + Right$(strPath, 1)
End If
End Function
1 comentario