Linked table manager button

This is probably VERY old school.  I borrowed and modified the code from a database I debugged seven years ago.  Well it still works in every front end/back end I put together.  I create an empty form and insert a Common Dialog Active X control on the form.  I make this form the startup form in the Front End properties.  It checks for the linked tables.  If they are not there it opens a Dialog box where the user browses and selects the back end.  Everything is relinked and updated in that user's front end.  Then at the end of all the code, you can call the original startup form smooth as silk.

Here are the different functions needed for your new startup form.  Change variables where desired.

Private Sub Form_Load()
On Error GoTo Form_Load_Err

    frontPath = CurrentDb.Name
   
    '  start at the end of the string and read backwards until we reach the '\'
    Dim tempIndex As Integer
    tempIndex = Len(Trim(frontPath))
   
    Do
        If Right(Left(frontPath, tempIndex), 1) = "\" Then Exit Do
        tempIndex = tempIndex - 1
    Loop
     
    frontPath = Left(frontPath, tempIndex)
   
    '  test to see if the tables are already linked or not
   
    Dim rsTemp As DAO.Recordset
    Set rsTemp = CurrentDb.OpenRecordset("tblAccountStatus", dbOpenDynaset)
   
    '  get the pathName and mdbName
    '  get the front end path
   
    pathName = GetSetting(appname:="ECTracking", Section:="PATH", _
                           key:="Path")
                           
    mdbName = GetSetting(appname:="ECTracking", Section:="PATH", _
                        key:="tablename")
                       
    DoCmd.Close
    DoCmd.OpenForm "frmKeepOpen", acNormal, , , , acHidden
    DoCmd.OpenForm "frmLetMeIn"
   
Form_Load_Exit:
    Exit Sub

Form_Load_Err:
    'MsgBox Err.Description
    Call LinkTables
End Sub


Sub LinkTables()
On Error GoTo linkTables_Err

Dim tableName As String

MsgBox "We are unable to automatically detect the location of your data tables.  Please select the path for data now."

tableName = getFileName
If tableName = "false" Then
    GoTo linkTables_Exit
End If

Dim tempIndex As Integer
Dim tempLength As Integer
Dim tempString As String

tempIndex = Len(tableName)
tempLength = Len(tableName)
pathName = ""
mdbName = ""

'  break the path into seperate path and file name info
'  get the mdbName
Do
    ' read backwards until we hit the '\'
    tempString = Right(Left(tableName, tempIndex), 1)
    If tempString = "\" Then Exit Do
    tempIndex = tempIndex - 1
Loop

mdbName = Right(tableName, (tempLength - tempIndex))
pathName = Left(tableName, tempIndex)
If Right(pathName, 1) = "\" Then
    pathName = Left(pathName, (Len(pathName) - 1))
End If

deleteLink ("tblAccountStatus")
DoCmd.TransferDatabase acLink, "Microsoft Access", tableName, acTable, "tblAccountStatus", "tblAccountStatus", False
deleteLink ("tblAdjustmentCodes")
DoCmd.TransferDatabase acLink, "Microsoft Access", tableName, acTable, "tblAdjustmentCodes", "tblAdjustmentCodes", False
deleteLink ("tblAssignedTo")
DoCmd.TransferDatabase acLink, "Microsoft Access", tableName, acTable, "tblAssignedTo", "tblAssignedTo", False
deleteLink ("tblBillTypes")
DoCmd.TransferDatabase acLink, "Microsoft Access", tableName, acTable, "tblBillTypes", "tblBillTypes", False
deleteLink ("tblCPTCodes")
DoCmd.TransferDatabase acLink, "Microsoft Access", tableName, acTable, "tblCPTCodes", "tblCPTCodes", False

--There are many more tables that get linked and I'm removing them for brevity.
--Also these lines are breaking in the margin pretty funky.  Sorry for the tough read.

'  if the link was successful,  save the path of the back-end to a text file

SaveSetting appname:="ECTracking", Section:="PATH", _
            key:="Path", setting:=pathName

SaveSetting appname:="ECTracking", Section:="PATH", _
            key:="tablename", setting:=mdbName

linkTables_Exit:
    DoCmd.Close
    DoCmd.OpenForm "frmKeepOpen", acNormal, , , , acHidden
    DoCmd.OpenForm "frmLetMeIn"
    Exit Sub

linkTables_Err:
    MsgBox "You must choose the location of your data before proceeding!"
    DoCmd.Quit
   

End Sub

Sub deleteLink(tableName As String)
On Error GoTo Exit_deleteLink
    CurrentDb.TableDefs.Delete tableName
Exit_deleteLink:
    Exit Sub
End Sub

Function getFileName() As String
        On Error GoTo err_getFilename
    dlg1.DialogTitle = "Find Data Tables"
    dlg1.DefaultExt = "*.MDB"
    dlg1.Filter = "Microsoft Access Database|*.MDB"
    dlg1.Flags = cdlOFNExplorer + cdlOFNFileMustExist + _
        cdlOFNPathMustExist + cdlOFNHideReadOnly + _
        cdlOFNLongNames + cdlOFNNoReadOnlyReturn
    dlg1.ShowOpen
    getFileName = dlg1.fileName
    GoTo exit_getFilename

err_getFilename:
    getFileName = "false"
   
exit_getFilename:
End Function

This is pretty involoved. I use a table, that contains all of the names of the tables that I want to link. I use a form, which also has a table to store the path to the back end. I used a common dialog box on the form so that the user can browse to the back end if it is not found.

How is your coding?

I agree.  Even if you copy and paste my solution, there is work involved at the Intermediate Coding level.  But even jefftwilley's solution requires: 1. a table to store table names (good idea - easy to update versus updating function when you add/remove a table).  2.  a form to either populate the table names and/or store/select the back end path.  And 3. the code to update the path and relink the tables.

Step 3 has to exist somewhere in some form.  I just so happened to give you all the code behind one form and one form only.  You can make the empty form, add the common dialog control and paste the code easy.  Then update the code to match your table names.  Most importantly, though, if jefftwilley's is shorter and sweeter, then I'm happy to borrow his solution for my projects too!  Why not?

Thanks!

This is what I use. IT can be modified slightly to include a quick check for current path using this function

Function AppPath() As String
   
    Dim pos As Integer, last As Integer
    Do
        last = pos
        pos = InStr(pos + 1, CurrentDb.Name, "\")
    Loop While pos > 0
    AppPath = Left(CurrentDb.Name, last)
   
End Function

here's my linktable code
Public Function Link_Tables()
' Enable error handler for this routine
    On Error GoTo err_Link_Tables
' Dimension recordset
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim strPath As String
    Dim strTableName As String
' Lookup the existing path
    strPath = DLookup("Data_Path", "tbl_SetUp") & ""
' if the path is empty, give the user a chance to use the form to find it
    If strPath = "" Then
        DoCmd.OpenForm "frm_DataPath", acNormal, , , , acDialog
    End If
    strPath = DLookup("Data_Path", "tbl_SetUp") & ""
' If the selected path isn't found (unlikely) then give them a second chance
    If Not Dir(strPath) <> "" Then
        DoCmd.OpenForm "frm_DataPath", acNormal, , , , acDialog
    End If
    strPath = DLookup("Data_Path", "tbl_SetUp") & ""

    DoCmd.SetWarnings False
' Open a recordset on table tblSetup. This table has all the table names in it
    strSQL = "Select t_Name from tbl_Tables;"
    Set rs = CurrentDb.OpenRecordset(strSQL)
    rs.MoveFirst
    Do Until rs.EOF
        strTableName = rs.Fields("t_Name").Value
        ' Delete the table
        DoCmd.DeleteObject acTable, strTableName
        ' Re-link the tables
        DoCmd.TransferDatabase acLink, "Microsoft Access", strPath, acTable, strTableName, strTableName
        rs.MoveNext
    Loop
' Close the recordset and release resources
    rs.Close
    Set rs = Nothing
' Exit the subroutine
    DoCmd.SetWarnings True

    Exit Function
err_Link_Tables:
    Select Case Err
        Case 7874   ' Object doesn't exist so it cannot be deleted
            Resume Next
        Case Else
            MsgBox "Function modCode" & ".Link_Tables." & vbCrLf & vbCrLf & "You have error number " & Err & ".  " & Err.Description
    End Select

End Function

this is what my tbl_Setup looks like

Data_Path
D:\Databases\Env_Data.mdb

The form uses this as it's recordsource. There is a textbox on the form that displays the path. There is a button that launches the common dialog that jcampanali pasted in that puts the path and filename into the textbox when selected.

This is my tbl_Tables

t_ID      t_Name
1      tbl_AirEmissions
2      tbl_AirEmissions_x
3      tbl_AuditLog
4      tbl_Awards
5      tbl_Awards_x

this is the table that's opened and looped through to delete, then relink in my backend.

Let us know if you need more?

a shortcut, which may also work for you, is to select the Tools/Database Utilities/Linked Table Manager from the menu, and check the "Always Prompt for New Location" box. That way, if the back end isn't found it will automatically open a dialog box.
J

do you want a FE db that look for the Backend and link the tables when found?

That Linked Table Manager didn't save any settings and only worked when manually done from the menu.  Is that how it's supposed to work?

iglink,

Just a note:

If all you want to do is bring up the Linked Table Manager Dialog box, use this:

Private Sub Command0_Click()
    DoCmd.RunCommand acCmdLinkedTableManager
End Sub


Hope this helps in some way as well

Jeff Coachman

JC ... you beat me to it ... the "Poor Man's" LTM.  I was watching House and Boston (ill)Legal ... you know ... trying to have a life ... just about to post that.

Anyway, I've used it a few times for a quick and dirty LTM, when I don't have time to pull in my full-blown automated LTM.
KUDO's to you :-)

mx

mx,

Yeah, I use it for my generic "Manage Linked Tables" form.
...and I open the 'Link tables" dialog box as well:
    Application.RunCommand acCmdLinkTables

(of coures, only after I optimize my query that lists the tables!)
;)

Jeffc

he he he :-)

mx

i have a FE db that looks for the BE and link the tables.
move the BE to another folder and the FE will find it and link the tables.

how about that?

jefftwilley where do you put the code?

also what do you think of this solution I found on ee
https://www.experts-exchange.com/questions/20077742/Auto-linking-tables-at-startup.html

Jeff is out having Chinese food with his dad right now (seriously - bday) ...

Put that code in a Standard Module  ...

Code OVERLOAD in that other thread ... use JT's solution ... then give me all the points and don't tell Jeff ... he he he ... :-)

mx

nice mx...HJ!!
here's a link to a complete solution that we walked through recently...uses the code above (or very similar)

https://www.experts-exchange.com/questions/22576362/Linked-table-path-for-run-time-front-end.html

man ... did you inhale the food???  What about the DRINKS ... are you seeing double lines line linses of code code every where where ...

mx

na...pop didn't know I was coming..so it was a nice surprise for him. three times through the buffet line...sang happy birse day, ate cake...then drove 45 miles home. Not a bad time really!

I dont think that i have the control for the common dialogue box installed and when i package it doesnt get included.

My coding is not so good but i can paste it in the right place and adjust any thing that needs customising

the solution i posted above looked ok as i dont think it needs the common dialogue but when i cretaed the module, added the code then tried to call the function from the macro got an error that it couldnt find it

in the brackets are you supposed to put the front end database name, table name or backend database name, table name

I tried to look at the other link https://www.experts-exchange.com/questions/22576362/Linked-table-path-for-run-time-front-end.html but its all getting a bit confusing

this is the code from jdettmann

Function AreTablesAttached(strDataMDB As String, strTableName As String) As Integer
   
    Dim curDB As Database
    Dim curTableDef As TableDef
    Dim MyRecords As Recordset
    Dim intRet As Integer

    '  Open attached table to see if connection information is correct.
    '  Execute reattach if attachments are broken.
    '  Otherwise Exit if connection information is correct.
   
    AreTablesAttached = False
   
    On Error Resume Next
    Err = 0
    Set curDB = DBEngine.Workspaces(0).Databases(0)
    Set MyRecords = curDB.OpenRecordset(strTableName)
    If Err = 0 Then
      MyRecords.Close
    Else
      intRet = ReattachTables(strDataMDB)
      If Not (intRet) Then
        AreTablesAttached = False
        Call ApplicationExit
      End If
    End If
   
    If Not MyRecords Is Nothing Then
      MyRecords.Close
      Set MyRecords = Nothing
    End If
   
    Set curDB = Nothing

End Function

Function ReattachTables(strDataMDB As String) As Integer
   
    Const NONEXISTENT_TABLE = 3011
    Const DATAMDB_NOT_FOUND = 3024
    Const ACCESS_DENIED = 3051
    Const READ_ONLY_DATABASE = 3027
   
    ' For file dialog
    Dim strFileName As String
    Dim strSearchPath As String
    Dim strTemp As String
    Dim varRet As Variant
    Dim strAccessDir As String
   
    ' For setting attachments.
    Dim wrk As Workspace
    Dim dbRemote As Database
    Dim curDB As Database
    Dim curTableDef As TableDef
    Dim intNumberOfTables As Integer
    Dim intTableCount As Integer
    Dim strTable As String
    Dim strSourceTableName As String
    Dim i As Integer
   
    ' Get Location of MDB file
    strFileName = GetMDBName(strDataMDB)
    strFileName = Trim(strFileName)
    If strFileName = "" Then
        MsgBox "You can't run the application until you locate the " & strDataMDB & " database", 16, "Can't run the " & AppName()
        GoTo ReattachTables_Failed
    End If
   
    ' Open the backend database
    ' This is so the backend is not repeatedly opened and closed
    ' Makes a big difference under NT
    Set wrk = DBEngine.Workspaces(0)
    Set dbRemote = wrk.OpenDatabase(strFileName, False, False)
    If Err <> 0 Then
        If Err = DATAMDB_NOT_FOUND Then
          MsgBox "You can't run the application until you locate the " & strDataMDB & " database", 16, "Can't run the " & AppName()
        ElseIf Err = ACCESS_DENIED Then
          MsgBox "Couldn't open " & strFileName & " because it is read-only or it is located on a read-only share.", 16, "Can't run the " & AppName()
        ElseIf Err = READ_ONLY_DATABASE Then
          MsgBox "Can't reattach tables because" & strDataMDB & "is read-only or is located on a read-only share.", 16, "Can't run the " & AppName()
        Else
          MsgBox Error, 16, "Can't run the " & AppName()
        End If
        GoTo ReattachTables_Failed
    End If

   
    ' Loop through all tables, reattaching those with nonzero-length
    ' connect strings.
    Set curDB = DBEngine.Workspaces(0).Databases(0)
    intNumberOfTables = curDB.TableDefs.Count - 1
    varRet = SysCmd(SYSCMD_INITMETER, "Attaching tables", intNumberOfTables)
    intTableCount = 1
    i = 0

Do_Next_Table:
    Set curTableDef = curDB.TableDefs(i)
    If InStr(curTableDef.Connect, strDataMDB) > 0 Then
      strTable = curTableDef.Name
      strSourceTableName = curTableDef.SourceTableName
      Err = 0
      curDB.TableDefs.Delete strTable
      Set curTableDef = curDB.CreateTableDef(strTable)
      curTableDef.SourceTableName = strSourceTableName
      curTableDef.Connect = ";DATABASE=" & strFileName
      curDB.TableDefs.Append curTableDef
      If Err <> 0 Then
          If Err = NONEXISTENT_TABLE Then
            MsgBox "File '" & strFileName & "' does not contain required table '" & curTableDef.SourceTableName & "'", 16, "Can't run the " & AppName()
          ElseIf Err = DATAMDB_NOT_FOUND Then
            MsgBox "You can't run the application until you locate the " & strDataMDB & " database", 16, "Can't run the " & AppName()
          ElseIf Err = ACCESS_DENIED Then
            MsgBox "Couldn't open " & strFileName & " because it is read-only or it is located on a read-only share.", 16, "Can't run the " & AppName()
          ElseIf Err = READ_ONLY_DATABASE Then
            MsgBox "Can't reattach tables because" & strDataMDB & "is read-only or is located on a read-only share.", 16, "Can't run the " & AppName()
          Else
            MsgBox Error, 16, "Can't run the " & AppName()
          End If
          varRet = SysCmd(SYSCMD_REMOVEMETER)
          GoTo ReattachTables_Failed
      End If
      intNumberOfTables = intNumberOfTables - 1
      intTableCount = intTableCount + 1
      varRet = SysCmd(SYSCMD_UPDATEMETER, intTableCount)
    Else
      i = i + 1
    End If

    If i <= intNumberOfTables Then GoTo Do_Next_Table

ReattachTables_Exit:
    ReattachTables = True
    varRet = SysCmd(SYSCMD_REMOVEMETER)
   
    dbRemote.Close
    Set dbRemote = Nothing
    Set wrk = Nothing
    Set curDB = Nothing
   
   
    Exit Function

ReattachTables_Failed:
    ReattachTables = False
    Set curDB = Nothing
    Call ApplicationExit

End Function

My front end is called ISES.SRM.MDE
My backend is called ISES.SRM.Be.MDB
A table in my backend that is linked is called company

So I created a module and inserted the above code and called it AreTablesAttached

Then in the autoexe macro I created a line
Added run code
And browsed to the AreTablesAttached module
it came up with AreTablesAttached (<<database.mde>>,<<table>>)
which i replaced with "ISES.SRM.Be" and "company"
When I run the macro it sais it cant find the function

this is the expression run code for the macro
AreTablesAttached ("ISES.SRM.MDB","company")

and the error is
The expression you entered has a funciton name that ISES - Strategic Risk Mangaement module cant find

Also I get an error when I try to compile the code

Well, in the macro Function Name, the syntax in general is

=AreTablesAttached()     you need the equals sign and the parens ...

BUT ... you need to pass two arguments

=AreTablesAttached("ISES.SRM.Be.MDB","Company")

mx

"Also I get an error when I try to compile the code"

Now that ... is yet another problem.  What line does the error occur on and what is the error?

mx

hmmm so back to the ocx solution then?

OCX ??

I haven't been completely tuned here ... looooong day ...

mx

rename the module to something different than the function name. Like mod_whatever

see if the compile errors go away

<<which all means that you do not have the complete code example ... this code calls other functions ... so, it's not going to work yet :-(>>

  As mx pointed out, the code for re-linking that was posted is incomplete.   There are several routines that are not included.   AppName() simply returns a string value with the name of the app.  GetMDBName() is a routine that presents an open dialog to the user asking them to locate the backend MDB/MDE.  

  The author contacted me off-line and I will send a complete module as soon as I get the chance.

  If anyone else would like the full module, drop me a line at:  jimdettman'at'earthlink.net and I'll send it along.

  Please note; this is very old code written originally for Access 2.0.  It will work with any version, but there are some things in there that I cringe at.  I've never bother to cleanup anything though because it does work as is.

JimD

   FYI I just sent off a sample to the author and discovered that I did re-factor this code a bit at some point.  The sample I have includes a Refresh of existing table links like the code that was posted above and includes a Reattach procedure which works as Jeff outlined off a table.

JimD.

  and iqlink, before I forget, please do not accept any of my comments as answers.  The points should go to the others who have helped on this thread.

JimD

JD ... we all cringe at times ... not to worry.  I'm scared to look at some Access 1.0 and 1.1 mdb's I still have ... and fortunately, it would be difficult to actually get them open in year 2007 :-)

mx