spitzmuller
Programmer
Hi out there
I have a Front-End database that contains links to tables in a password protected backend database.
The two databases reside on a server and the user start the database from there. Due to IT-restructurisation, the location where the databases are saved will change a few times.
Since the linked tables are absolute paths to the backend, I have written some VBA to relink the backend tables automatically when the frontend starts. Worked a charm, but now the backend is protected by a database password and my relinking fails.
does anybody know how i can still relink the tables in code?
Here's what I use at the moment:
I have a Front-End database that contains links to tables in a password protected backend database.
The two databases reside on a server and the user start the database from there. Due to IT-restructurisation, the location where the databases are saved will change a few times.
Since the linked tables are absolute paths to the backend, I have written some VBA to relink the backend tables automatically when the frontend starts. Worked a charm, but now the backend is protected by a database password and my relinking fails.
does anybody know how i can still relink the tables in code?
Here's what I use at the moment:
Code:
Public Function RefreshLinks(dbPath As String, ReportErrors As Boolean) As Boolean
Dim td As TableDef
Dim fso As FileSystemObject
Dim sField As String
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
'1) check if file exists
fso.GetFile (dbPath)
If Err.Number <> 0 Then
If ReportErrors Then MsgBox "Fehler beim Verbinden mit der BackEnd-Datenbank."
RefreshLinks = False
Exit Function
End If
'2) refresh all links
For Each td In CurrentDb.TableDefs 'check each table
If Len(td.Connect) > 0 Then 'see if its a linked table... if so then see if we can access the name property of the first field
sField = td(0).Name
If Err.Number <> 0 Then 'couldnt access field, so try and reattach
Err.Clear 'clear error
td.Connect = ";DATABASE=" & dbPath
td.RefreshLink
If Err.Number <> 0 Then
If ReportErrors Then MsgBox "Der Link zur Tabelle '" & td.Name & "' konnte nicht wiederhergestellt werden."
Err.Clear
RefreshLinks = False
Exit Function
End If
End If
End If
Next td
On Error GoTo 0
RefreshLinks = True
End Function