Link table at runtime 1

Yes, and it's not that difficult

Copy the following subroutine to a bas module:

Public Sub LinkTables(strDatabase As String)
Dim dbs As Database
Dim tdf As TableDef
Dim intI As Integer

Set dbs = CurrentDb
Set tdf = dbs.TableDefs(0)

For intI = 0 To dbs.TableDefs.Count - 1
Set tdf = dbs.TableDefs(intI)
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & strDatabase
tdf.RefreshLink
End If
Next intI

End Sub

Calling this sub ( e.g. Call LinkTables("C:\MyFolder\Mydb.mdb&quot will redirect all linked tables to the database specified.



Bill Paton
william.paton@ubsw.com
Check out my website !

Thanks Bill
Doesn't this require that I know ahead of installation of the program & data files, where they are located? Can the link be directed to be the same directory as the program.mdb? So no mater where I load the program and data files the link will always be the same.

Maybe I'm looking for too much. I just don't want to have to redirect the link after the directory is established. If I make an installation then I have to know ahead of installation time what the directory is.

Burr

Burr Stephens
burr-stephens@worldnet.att.net

Burr,

No problem, but you need more code. Again place the following sub in a bas module:

Private Function GetDBDir() As String

' Purpose:
' Gets the directory of the currently open database.
' Based on code originally from Mike Gunderloy.
'
' From Access 97 Developer's Handbook
' by Litwin, Getz and Gilbert. (Sybex)
' Copyright 1997. All Rights Reserved.
'
' In:
' None
' Out:
' Return Value - The name of the directory as a string
' History:
' Created 09/13/94 pel; Last Modified 12/20/95 pel

On Error GoTo GetDBDirErr

Dim dbCurrent As Database
Dim strDbName As String
Dim strProcName As String

strProcName = "GetDBDir"

Set dbCurrent = CurrentDb
strDbName = dbCurrent.Name

Do While Right$(strDbName, 1) <> &quot;\&quot;
strDbName = Left$(strDbName, Len(strDbName) - 1)
Loop

GetDBDir = UCase$(strDbName)

GetDBDirDone:
On Error GoTo 0
Exit Function

GetDBDirErr:
Select Case Err
Case Else
MsgBox &quot;Error#&quot; & Err.Number & &quot;: &quot; & Err.description, _
vbOKOnly + vbCritical, strProcName
Resume GetDBDirDone
End Select

End Function

Now a small change to the LinkTables Routine:

Public Sub LinkTables(strDatabase As String)
Dim dbs As Database
Dim tdf As TableDef
Dim intI As Integer

Set dbs = CurrentDb
Set tdf = dbs.TableDefs(0)

For intI = 0 To dbs.TableDefs.Count - 1
Set tdf = dbs.TableDefs(intI)
If Len(tdf.Connect) > 0 Then
tdf.Connect = &quot;;DATABASE=&quot; & GetDbDir() & &quot;\&quot; & strDatabase
tdf.RefreshLink
End If
Next intI

End Sub

Thus you call to LinkTable will now be just Call LinkTables(&quot;YourDbName.mdb&quot



Bill Paton
william.paton@ubsw.com
Check out my website !

Thanks Bill,
That will do it. I'm pleasantly supprised and appreciative of the help I've gotten from the Tec-Tips. You guys must like to write programs. My limited knowledge has gotten me in trouble and you have bailed me out several times. I'm not a profesional programmer. I am doing this job as a volunteer for a local free health clinic.
What book or tutorial would assist me in learning more of this level of programming?
Many many thanks.


Burr Stephens
burr-stephens@worldnet.att.net

Ok Bill,
I can't make it work. I suspect I'm not describing the problem correctly.
I have all my forms, reports, code, querys, etc in a file called programs.mdb.
I have 1 table in another file called data.mdb. These both reside in a common
directory. This directory name is unknown to me until I load it into the server.
If I link the table manualy after I load the files, the program runs ok. I want
to Load the files, maybe even with an ftp load, and have the table linked.
I'm not able to apply the code you gave me.


Burr Stephens
burr-stephens@worldnet.att.net

As long as the backend and frontend are located in the same folder. Copy all of the following code to a new module. Call the CheckLink function from an autoexec macro or run it from the On Open event of a start up form. The code will check and relink the tables no matter where the app is installed. You don't have to specify and path or location.

Note.........
In the line: Public Const constrData As String = &quot;db_source.mdb&quot;
Change &quot;db_source.mdb&quot; to the name of your backend db.

'*****************Start Code*******************************
'This function checks the linked tables in the current database and repairs broken
'links. The database containing the source tables must reside in the same directory
'and it name must be entered in the constant constrData
'Call the function CheckLink in the AutoExec macro or in the OnOpen event
'of the startup form.

Public Const constrData As String = &quot;db_source.mdb&quot;
'Constant with the name of the database that contains the source tables

Public Function CheckLink() As Boolean
Dim fRepairNeeded As Boolean
Dim rsTable As Recordset
Dim tdTable As TableDef

On Error GoTo LinkError
For Each tdTable In CurrentDb.TableDefs
'Check for each table if it is part of the mdb or if it is a linked table
'The connect property of linked tables contain the path of the source db
If Len(tdTable.Connect) > 0 Then
'Open the linked table, if it isn't available an error is raised and
'the error routine will be executed
Set rsTable = CurrentDb.OpenRecordset(tdTable.Name, dbOpenSnapshot)
rsTable.Close
End If
Next tdTable

CheckLink = True
If fRepairNeeded Then
MsgBox &quot;Linked tables are reattached&quot;, _
vbOKOnly + vbCritical, _
&quot;Reattaching linked tables&quot;
End If

Set tdTable = Nothing
Set rsTable = Nothing
Exit Function

LinkError:
Select Case Err.Number
Case 0, 91
Resume Next
'Linked table isn't available. Call the function to repair the link
Case 3024
If Not Repairlink Then
CheckLink = False
MsgBox &quot;Not all linked tables could be reattached&quot;, _
vbOKOnly + vbCritical, _
&quot;Reattaching linked tables&quot;
Set tdTable = Nothing
Set rsTable = Nothing
Exit Function
Else
fRepairNeeded = True
Resume Next
End If
Case Else
MsgBox Err.Number & &quot; &quot; & Err.Description
CheckLink = False
Set tdTable = Nothing
Set rsTable = Nothing
Exit Function
End Select
End Function

Public Function Repairlink() As Boolean
Dim dbApplic As DATABASE
Dim intCounter As Integer
Dim strDir As String
Dim tdTable As TableDef

Set dbApplic = CurrentDb

'Get the directory out of the Name property of the current database
For intCounter = Len(dbApplic.Name) To 1 Step -1
If Mid(dbApplic.Name, intCounter, 1) = &quot;\&quot; Then
strDir = Mid(dbApplic.Name, 1, intCounter)
Exit For
End If
Next intCounter

For Each tdTable In dbApplic.TableDefs
'If the table has a connect string than it is a linked table
'The link must be repaired
If Len(tdTable.Connect) > 0 Then
'constrData is the constant containing the name of the source database
tdTable.Connect = &quot;;DATABASE=&quot; & strDir & constrData
Err.Number = 0
On Error Resume Next
tdTable.RefreshLink
If Err.Number <> 0 Then
Repairlink = False
Exit Function
End If
End If
Next tdTable
Repairlink = True

Set tdTable = Nothing
Set dbApplic = Nothing
End Function
'*******************End Code*******************************

HTH s-)
RDH

Ricky Hicks
rdhicks@mindspring.com

Randy!!!
That did the job. Thanks. The only problem I had was calling it from an open form event. The form was looking for the table that hadn't been linked yet. I called it from the autoexec macro and works ok....Many thanks. Now what can I read to learn more about how this works?

Burr Stephens
burr-stephens@worldnet.att.net

The problem you had with using the Open Form event to trigger the &quot;CheckLink&quot; code is that the form can not be bound to any of the linked tables. This is usally the case if you have a custom splash form. This form is not usally bound to any table or query. The code would work fine in the situation. But I'm glad you got it to work using the Autoexec macro.

Good Luck,
RDH

Ricky Hicks
rdhicks@mindspring.com

old post, but to answe the question asking for a good book, I'll copy from the comments in one of the pieces of code:

' From Access 97 Developer's Handbook
' by Litwin, Getz and Gilbert. (Sybex)
' Copyright 1997. All Rights Reserved.
'

It's sitting on my desk right now; it assumes some familiarity, but it is a good reference that comes with many code and database samples, printed and electronic. (A CD comes with the book.)
Shhhh... ...it's a secret. >NOT!< -- C Vigil =)
(Before becoming a member, I also signed on several posts as
&quot;JustPassingThru&quot; and &quot;QuickieBoy&quot; -- as in &quot;Giving Quick Answers&quot

HELP!
I copied and pasted the above code by RHICKS. I can not get it to work.
I have both FE and BE in the same folder. I made a Macro and named it autoexec. In the Macro I chose RUNCODE and typed in CheckLink() in the Function Name line.
What am I doing wrong? I get NO error message. It just does nothing.
Thanks

Thomas Bailey
tbailey@datjc.com

Below is the code I copied from RHICKS above. Again it does nothing to my database. I make a Macro and use RUNCODE and place CheckLink() in the Function name line.

START CODE:
'This function checks the linked tables in the current database and repairs broken
'links. The database containing the source tables must reside in the same directory
'and it name must be entered in the constant constrData
'Call the function CheckLink in the AutoExec macro or in the OnOpen event
'of the startup form.

Public Const constrData As String = "FileName_be.mdb"
'Constant with the name of the database that contains the source tables

Public Function CheckLink() As Boolean
Dim fRepairNeeded As Boolean
Dim rsTable As Recordset
Dim tdTable As TableDef

On Error GoTo LinkError
For Each tdTable In CurrentDb.TableDefs
'Check for each table if it is part of the mdb or if it is a linked table
'The connect property of linked tables contain the path of the source db
If Len(tdTable.Connect) > 0 Then
'Open the linked table, if it isn't available an error is raised and
'the error routine will be executed
Set rsTable = CurrentDb.OpenRecordset(tdTable.Name, dbOpenSnapshot)
rsTable.Close
End If
Next tdTable

CheckLink = True
If fRepairNeeded Then
MsgBox "Linked tables are reattached", _
vbOKOnly + vbCritical, _
"Reattaching linked tables"
End If

Set tdTable = Nothing
Set rsTable = Nothing
Exit Function

LinkError:
Select Case Err.Number
Case 0, 91
Resume Next
'Linked table isn't available. Call the function to repair the link
Case 3024
If Not Repairlink Then
CheckLink = False
MsgBox "Not all linked tables could be reattached", _
vbOKOnly + vbCritical, _
"Reattaching linked tables"
Set tdTable = Nothing
Set rsTable = Nothing
Exit Function
Else
fRepairNeeded = True
Resume Next
End If
Case Else
MsgBox Err.Number & " " & Err.Description
CheckLink = False
Set tdTable = Nothing
Set rsTable = Nothing
Exit Function
End Select
End Function

Public Function Repairlink() As Boolean
Dim dbApplic As Database
Dim intCounter As Integer
Dim strDir As String
Dim tdTable As TableDef

Set dbApplic = CurrentDb

'Get the directory out of the Name property of the current database
For intCounter = Len(dbApplic.Name) To 1 Step -1
If Mid(dbApplic.Name, intCounter, 1) = "\" Then
strDir = Mid(dbApplic.Name, 1, intCounter)
Exit For
End If
Next intCounter

For Each tdTable In dbApplic.TableDefs
'If the table has a connect string than it is a linked table
'The link must be repaired
If Len(tdTable.Connect) > 0 Then
'constrData is the constant containing the name of the source database
tdTable.Connect = ";DATABASE=" & strDir & constrData
Err.Number = 0
On Error Resume Next
tdTable.RefreshLink
If Err.Number <> 0 Then
Repairlink = False
Exit Function
End If
End If
Next tdTable
Repairlink = True

Set tdTable = Nothing
Set dbApplic = Nothing
End Function
END CODE:

When I try to compile, I get a syntax error on the following line:

Public Const constrData As String = "FileName_be.mdb"

Thanks.

Thomas Bailey
tbailey@datjc.com