Easy Code to Re-Link Tables

[tomcat21]

I need to be able to re-link Tables in Runtime. I package an .mde file using Access P&D. I need an easy way for the Front End to Re-Link to the Back End once installed on a client's server.

I understand it can done with code. Problem is, I know very little about code.
If code is provided, please let me know how to paste it. I know to put it in a Module, but what do you do from there. Do you create a Macro and use RunCode, do you place it in Form Design On Load, On Open, etc.?

Thanks,

Thomas Bailey

http://www.reportcop.com

tbailey@datjc.com

 

[thecreator]

The following code can be cut and paste into a new module.

Provided you do not use the database in any objects of your main form, (eg a list box that draws information from a linked table) then you can put the code line LinkTables in the On Open event for your form.

You will need to nominate the appropriate details in the connection string that suit your database -

Option Compare Database
Option Explicit

' declare public variables for environment settings
Public DB_Prefix As String
Public MyConnectionString As String

DB_Prefix = "dbuser."
' Prefix for SQL database user

MyConnectionString = "ODBC;Database=<dbname>;UID=<userid>;PWD=<pwd>;DSN=<dsn name"

Sub LinkTables()
On Error GoTo LinkTables_Err

Dim dbs As Database, tdf As TableDef
Dim MyTable As String, i As Integer
Dim arrTables(10) As String

' Define array of tables to link
arrTables(1) = "cfiacct"
arrTables(2) = "cfiproj"
arrTables(3) = "lapclas"
arrTables(4) = "lapcspa"
arrTables(5) = "lapcspb"
arrTables(6) = "lapcspc"
arrTables(7) = "lapcspm"
arrTables(8) = "lapfeca"
arrTables(9) = "lapfecb"
arrTables(10) = "lapfecd"

' Link Pathway tables to this database
Set dbs = CurrentDb

For i = 1 To UBound(arrTables, 1)
MyTable = Trim(DB_Prefix) + arrTables(i)
Set tdf = dbs.CreateTableDef(arrTables(i))
tdf.Connect = MyConnectionString
tdf.SourceTableName = MyTable
dbs.TableDefs.Append tdf
Next i

LinkTables_Bye:
' release objects
dbs.Close
Set tdf = Nothing
Set dbs = Nothing
Exit Sub

LinkTables_Err:
MsgBox Err.Description
Resume LinkTables_Bye

End Sub

Hope this helps

 

[LittleSmudge]

The following code removes all old links and makes new links to ALL of the tables that it finds in the target back end database.

Place the following three procedures in a module ( I call mine mdlLinkedTables )

Function GetLinkedConnectStrings()
On Error GoTo Err_GetLinkedConnectStrings

Dim db As Database
Dim doc As Document
Dim tbf As TableDef

DoCmd.Hourglass True
Set db = CurrentDb
  
  For Each tbf In db.TableDefs
    DoEvents
    If Not Left(tbf.Name, 4) = "MSys" Then
      'ignore system tables
      Debug.Print tbf.Name & "; " & tbf.Connect
    End If
  Next tbf

Exit_GetLinkedConnectStrings:
On Error Resume Next
DoCmd.Hourglass False
db.Close
Set db = Nothing

Exit Function

Err_GetLinkedConnectStrings:
  Select Case Err
  Case 0    'insert Errors you wish to ignore here
    Resume Next
  Case 3011 'object not found
    Resume Next
  Case 3045 'database already in use
    Beep
    MsgBox "The database is in use by someone else. " _
         & "Go and evict them and try again.", , "You are not alone."
  Case Else 'All other errors will trap
    Beep
    MsgBox "Error deleting tables.@" & Err.Number & "; " & Err.Description
  Resume Exit_GetLinkedConnectStrings
  End Select
  Resume 0  'FOR TROUBLESHOOTING
End Function

Public Sub DeleteTableLinks(Optional strConnectString As String = "")
'If strConnectString is omited all links will be removed
Dim tdf As TableDef
For Each tdf In CurrentDb.TableDefs
    If tdf.Connect <> "" Then 'Check for linked tables
        'Check for pointed links
        If InStr(1, tdf.Connect, strConnectString, vbTextCompare) > 0 Then
            'Removing links
            DoCmd.DeleteObject acTable, tdf.Name
            DoCmd.Echo True, "Progress: Deleting link to table " & tdf.Name
        End If
    End If
Next tdf
End Sub

Public Sub RemakeTableLinks()
On Error GoTo Err_RemakeTableLinks
Dim dbs As Database
Dim tdf As TableDef
Dim strLinkSourceDB As String
Dim tdfCount As Long
Dim intCount As Long

' Need to go get database from user
' Replace this with a more appropriate FileFind if necessary
Select Case MsgBox("If you are connecting to the XXXX Server, click on Yes" & vbLf _
                 & "If you are connecting to the YYYY Server, click on No" _
                 , vbYesNoCancel, "Get Data From User")
    Case Is = vbYes
        strLinkSourceDB = "\\XXXX\Ash.mdb"
    Case Is = vbNo
        strLinkSourceDB = "\\YYYY\And.mdb"
    Case Else
        MsgBox "Option to Terminate selected.", , "No Link to Make"
        Exit Sub
End Select

'Open source DB
Set dbs = OpenDatabase(strLinkSourceDB)

'Counting tables in the source DB
For Each tdf In dbs.TableDefs
    If Left(tdf.Name, 4) <> "MSys" Then
        'Do not link to the System tables
        tdfCount = tdfCount + 1
    End If
Next tdf
'Check all tables in source DB (dbs)
For Each tdf In dbs.TableDefs
    If Left(tdf.Name, 4) <> "MSys" Then
        'Do not link to the System tables
        'Creating links
        intCount = intCount + 1
        DoCmd.TransferDatabase acLink, "Microsoft Access", strLinkSourceDB, acTable, tdf.Name, tdf.Name
        DoCmd.Echo False, "Progress: Linking table " & intCount & " of " & tdfCount
    End If
Next tdf
'Close source DB
dbs.Close
Set dbs = Nothing

Exit_RemakeTableLinks:
DoCmd.Echo True
Exit Sub

Err_RemakeTableLinks:
MsgBox Err.Description, , "mdlLinkedTable, Sub RemakeTableLinks " & Err.Number
Resume Exit_RemakeTableLinks
End Sub

Then on your admin management form you need a button
cmdRemakeLinks

Private Sub cmdRemakeLinks_Click()
If MsgBox("Are you REALLY sure?", vbYesNo, "Just checking.") = vbYes Then
    Call DeleteTableLinks       ' Sub in mdlLinkedTable
    Call RemakeTableLinks       ' Sub in mdlLinkedTableEnd If
End Sub

'ope-that'elps.

G LS
spsinkNOJUNK@yahoo.co.uk
Remove the NOJUNK to use.

 

[tomcat21]

Okay, Like I said, I am not good with code.
LittleSmudge,
I pasted the code in a module. How do I complete the cmdbutton?
I assume you are saying to create a cmbutton in Form Design of the Main Switchboard so that the user can click on to Re-Link Tables.
Call me dumb but how exactly do I make the cmdbutton. I know how to make cmdbuttons and open forms, queries, etc. but on this particular code, how do I create the cmdbutton to run reference the module?
Thanks,

Thomas Bailey

http://www.reportcop.com

tbailey@datjc.com

 

[tomcat21]

Okay, I got it to work. I got the cmdbutton referencing the Module. I assume I need to put the name of my app in somewhere. Where exactly do I insert the name of my app? (ex. app name "FILE").
What is the XXXX and YYYY? I assume they are server names, but why two of them and what if I don't know the name of their server?
Thanks.

Thomas Bailey

http://www.reportcop.com

tbailey@datjc.com

 

[LittleSmudge]

\\XXXX\Ash.mdb is the server\path\file name

If you don't know the server name then use the mapped path name - but that will cause problems if you move this FE to another machine where the mappings are different.


The reason there is an XXX and a YYY in the code is because I have the option to link to two replicas depending on the location of the FE.

If you only need one BE file name replace all from

' Need to go get database from user

down to

End Select

with

strLinkSourceDB = "D:\PathName\FileName.mdb"

and replace PathName\FileName with your real Path and File names




'ope-that-'elps.




G LS
spsinkNOJUNK@yahoo.co.uk
Remove the NOJUNK to use.

 

[tomcat21]

Thanks,
I finally got it to work.
But you still would have to know the customers server name and path to get it to work. Are you going to always have to know either the Server name and/or Path?

Thanks

Thomas Bailey

http://www.reportcop.com

tbailey@datjc.com

 

[tomcat21]

I spoke to soon. The DeleteTableLinks works GREAT. The links are deleted, but then I get an error when it tries to relink. I have the correct server name and path, etc. The code is:

Public Sub RemakeTableLinks()
On Error GoTo Err_RemakeTableLinks
Dim dbs As Database
Dim tdf As TableDef
Dim strLinkSourceDB As String
Dim tdfCount As Long
Dim intCount As Long

' Need to go get database from user
strLinkSourceDB = "\\Server\Folder\ApplicationName.mdb"

End Select


The error I get is:

Compile Error:
End Select without Select Case

What am I doing wrong?

Thomas Bailey

http://www.reportcop.com

tbailey@datjc.com

 

[LittleSmudge]

When you deleted out the select stuff that I had in originally you didn't take enough lines out.

There is a line

End Select

in there that needs deleting.



As for knowing the Server.
YES in my case I do know the server\path\file names

There's a limited option so I gave the user a select from this list type ap[proach.

However, you could stick in a FileOpen dialog box to allow the user to browse the network neighbourhood to find the server\path\file that they want. ( If you trust the user enough to give then that flexibility )


'ope-that-'elps.



G LS
spsinkNOJUNK@yahoo.co.uk
Remove the NOJUNK to use.

 

[tomcat21]

When I delete:
End Select
I get an error stating that the path/file name is wrong or mispelled. I have checked it a hundred times and I KNOW it is the right path. I only get this when I take out:
End Select.



Thomas Bailey

http://www.reportcop.com

tbailey@datjc.com

 

[LittleSmudge]

Yes - The parser will find the End Select problem first and flag that.
Get rid of that problem and it moves on to a run time problem.

Post the section of code in here and I'll see if there is something subtly wrong wit the code.





G LS
spsinkNOJUNK@yahoo.co.uk
Remove the NOJUNK to use.

 

[tomcat21]

I feel STUPID!
I was including the domain name in the path.

I got it to work now. Thanks for all the HELP!

Thomas Bailey

http://www.reportcop.com

tbailey@datjc.com