How Do I programmatically change path to Link Tables?

[Sanjay Chavda]

We have developed an application in Access 97.

the Data is stored in separate MDB File.

I used Database splitter to create this file.

Now I do not know at client's site in which directory this application will be stored.

Both the files will be stored in the same directory that I know.

The problem with Access is that it hard codes the Link Table Path. Even if you rename the directory where both the MDB files are stored, it will stop working. I Do not want client update link tables from ADDIN and selecting LINK Table Manager.

 

Any Help.

 

Sanjay Chavda

san...@telebot.net

 

[Doug Steele]

Dev Ashish has sample code for relinking tables (see
http://www.mvps.org/access/tables/tbl0009.htm). You can determine where
your application database is by parsing CurrentDB().Name: something like
Left$(CurrentDB().Name,
Len(CurrentDB().Name)-Len(Dir(CurrentDB().Name))) should do it.

HTH

--

Beer, Wine and Database Programming. What could be better?
Visit "Doug Steele's Beer and Programming Emporium"
http://webhome.idirect.com/~djsteele/

[DFAS User]

I use this code:

Option Compare Database   'Use database order for string comparisons

Option Explicit

Global StrDbPath As String
 
 
 

Function GetCurrentDbPath() As String

On Error GoTo GetCurrentDbPathError

'From a method first proposed by Ken Getz
    Dim strPath As String
    Dim db As Database
    Set db = CurrentDb()
    strPath = db.Name
    GetCurrentDbPath = Left(strPath, Len(strPath) - Len(Dir(strPath)))
GetCurrentDbPathExit:

    Exit Function

GetCurrentDbPathError:

    MsgBox Application.CurrentObjectName & " - Error in GetCurrentDbPath().  " & Error$ & "  Err No:  " & Err, 16
    Resume GetCurrentDbPathExit

End Function
 
 
 

Sub Relinktables()

    On Error GoTo RelinktablesError

    Dim db As Database
    Dim tdPurge As TableDef, tdTBO_IN As TableDef, tdTBO_INFO As TableDef

    Set db = CurrentDb()

    Set tdPurge = db.TableDefs("Purge")
    Set tdTBO_IN = db.TableDefs("TBO_IN")
    Set tdTBO_INFO = db.TableDefs("TBO_INFO")
 
    tdPurge.Connect = ";DATABASE=" & StrDbPath & "Purgedb.MDB"
    tdPurge.RefreshLink
    tdTBO_IN.Connect = "dBASE III;DATABASE=" & StrDbPath
    tdTBO_IN.RefreshLink
    tdTBO_INFO.Connect = "dBASE III;DATABASE=" & StrDbPath
    tdTBO_INFO.RefreshLink
 
RelinktablesExit:

    Set tdPurge = Nothing
    Set tdTBO_IN = Nothing
    Set tdTBO_INFO = Nothing
    Set db = Nothing
    Exit Sub

RelinktablesError:

    MsgBox Application.CurrentObjectName & " - Error in RelinkHistorytables().  " & Error$ & "  Err No:  " & Err, 16
    Resume RelinktablesExit
 
End Sub
 

Sanjay Chavda wrote:

We have developed an application in Access 97.the Data is stored in separate MDB File.I used Database splitter to create this file.Now I do not know at client's site in which directory this application will be stored.Both the files will be stored in the same directory that I know.The problem with Access is that it hard codes the Link Table Path. Even if you rename the directory where both the MDB files are stored, it will stop working. I Do not want client update link tables from ADDIN and selecting LINK Table Manager. Any Help. Sanjay Chavdasan...@telebot.net 

[HAXOR2000]

here is some code for access 2.0  It consists of a few functions to do an attach via a form that asks where the data tables reside 

 

this belongs in the declarations section:

Option Compare Database   'Use database order for string comparisons

Global datadb As String'= "c:\access\1121DATA.mdb"  '***used to globally set the attached database
                                                      '****so we can use the opentable method

'   I HAVE EDITED THE ATTACH CODE TO INCLUDE "DATADB AS A GLOBAL VARIABLE...
'   Now when the database opens, and the data table has been renamed or moved,
'   the code does a reference to the "MSYSOBJECTS" table and looks up the path to the
'   attached database from the "database" field in that table. This field is updated
'   every time you attach a table.So... Now the code applies the attach string to the
'   Global variable, and all is well!!. It also checks and defines the variable every time
'   the autoexec macro runs. REAL COOL STUFF!!
'       chris.........

this function checks for attached tables:

 

  Dim db As Database
    Dim CurrDBTbls As Snapshot
    Dim ds As Dynaset

 

    On Error GoTo CheckTabletrap
    Set db = CurrentDB()
    Set CurrDBTbls = db.ListTables()                            'Gets a list of tables in the current DB
    CurrDBTbls.MoveFirst                                        'Moves to the first table in the list
    Do Until CurrDBTbls.eof                                     'This loop is used to find an attached table
        If CurrDBTbls![tabletype] = db_attachedtable Then       'Checks to see if it's an attached table
            Set ds = db.CreateDynaset(CurrDBTbls![name])        'Tests the attached table.  If it fails, it goes to the error trap.  Otherwise, it just continues through the function.
            Exit Do
        End If
        CurrDBTbls.MoveNext                                     'Moves to the next table in the list
    Loop
    ds.Close                                                    'Closes the VT object
    CurrDBTbls.Close                                            'Closes the VT object
    db.Close                                                    'Closes the VT object

 

                                                                'This code looks up the datadb string in msysobjects
    Dim sd As Database, tb As Table
    Static dpath As String                                      'and applies it to the datadb global variable.
    Set sd = CurrentDB()
    Set tb = sd.OpenTable("msysobjects")
    tb.MoveLast
    tb.MovePrevious
    Do While IsNull(tb!database)
        If IsNull(tb![database]) Then
        tb.MovePrevious
        If tb.bof Then
        MsgBox " Cannot find internal path to Tables, System Object Table Contains Null, Call SLC COMPUTERS.", 33, "The Practice Manager"
        tb.Close
        sd.Close
        Exit Function
        End If
        End If
    Loop
    dpath = tb![database]
    datadb = dpath
    tb.Close
    sd.Close
  
Exit Function
CheckTabletrap:
DeleteAttach                                                'Opens the sub procedure that deletes the current attachments
    Exit Function
End Function

 

Sub DeleteAttach ()                                                 'This function deletes any attached tables
    Dim db As Database, CurrDBTbls As Snapshot
    On Error Resume Next
    Set db = CurrentDB()
    Set CurrDBTbls = db.ListTables()                                'Gets a list of tables in the current DB
    CurrDBTbls.MoveLast
    s = SysCmd(1, "Deleting tables...", CurrDBTbls.recordcount)
    count = 0
    CurrDBTbls.MoveFirst                                            'Moves to the first table in the list
    DoCmd SetWarnings False                                         'Turns the warnings messages off for deleting tables
    Do Until CurrDBTbls.eof                                         'This loop is used to find attached tables
        If CurrDBTbls![tabletype] = db_attachedtable Then           'Only finds attached tables
            DoCmd SelectObject A_table, CurrDBTbls![name], True     'Selects the attached table
            DoCmd DoMenuItem 1, 1, 4                                'Deletes the attached table
            s = SysCmd(2, count)
        End If
        count = count + 1
        CurrDBTbls.MoveNext                                         'Moves to the next table in the list
    Loop
    DoCmd SetWarnings True                                          'Turns the warnings back on
    s = SysCmd(5)
    DoCmd OpenForm "frm reattach"                                   'Opens a form to ask the user for the new location of the tables database
    CurrDBTbls.Close                                                'Closes VT object
    db.Close                                                        'Closes VT object
End Sub

Function FRMCancel ()                   'This functions closes the database
    DoCmd Close                         'Closes the form
    SendKeys "{f11}", True              'Selects the DB container window
    DoCmd DoMenuItem 1, 0, 2            'Closes the DB
End Function

this function does the actual attaching to the external tables:

 

 

Function FRMok (f As Form)
    Dim db As Database
    Dim OtherDBTbls As Snapshot
    Dim OtherDBPath As String
    Dim GotOne

 

    On Error GoTo FRMokTrap
    OtherDBPath = f("dbpath")
    Set db = OpenDatabase(OtherDBPath)
    datadb = OtherDBPath
    DoCmd Close
    Set OtherDBTbls = db.ListTables()
    OtherDBTbls.MoveLast
    s = SysCmd(1, "Adding tables...", OtherDBTbls.recordcount)
    count = 0
    OtherDBTbls.MoveFirst
    DoCmd SetWarnings False
    Do Until OtherDBTbls.eof
        If Not Left(OtherDBTbls![name], 4) = "msys" And OtherDBTbls![tabletype] = db_table Then
            DoCmd TransferDatabase A_attach, "Microsoft Access", OtherDBPath, , OtherDBTbls![name], OtherDBTbls![name]
            s = SysCmd(2, count)
            GotOne = True
        End If
        count = count + 1
        OtherDBTbls.MoveNext
    Loop
    DoCmd SetWarnings True
    OtherDBTbls.Close
    db.Close
    s = SysCmd(5)
    If GotOne = True Then
        x = MsgBox("The tables were added successfully", 0, "The Practice Manager")
        DoCmd SelectObject a_form, "main", False
        DoCmd Maximize
                                                                 'This code looks up the datadb string in msysobjects
    Dim sd As Database, tb As Table
    Static dpath As String                                        'and applies it to the datadb global variable.
    Set sd = CurrentDB()
    Set tb = sd.OpenTable("msysobjects")
    tb.MoveLast
    tb.MovePrevious
    tb.MovePrevious
    If IsNull(tb![database]) Then
    MsgBox " Cannot find internal path to Tables", 33, "The Practice Manager"
    tb.Close
    sd.Close
    Exit Function
    End If
    dpath = tb![database]
    datadb = dpath
    tb.Close
    sd.Close
Exit Function
    Else
        x = MsgBox("The database doesn't contain any tables.", 0, "The Practice Manager")
        DoCmd OpenForm "frm reattach"
    End If
Exit Function
FRMokTrap:
    If Err = 94 Then
        x = MsgBox("You must enter the path to a database.", 0, "The Practice Manager")
        DoCmd GoToControl "dbpath"
        Exit Function
    End If
    If Err = 3044 Or Err = 3024 Then
        x = MsgBox("The path or filename specified is invalid.", 0, "The Practice Manager")
        DoCmd GoToControl "dbpath"
        Exit Function
    End If
    If Err = 3051 Then
        x = MsgBox("The file couldn't be opened." & Chr(13) & Chr(13) & Chr(10) & "It may be in/on a read-only directory/drive" & Chr(13) & Chr(10) & "or locked by another user.", 0, "The Practice Manager")
        DoCmd GoToControl "dbpath"
        Exit Function
    End If
    If Err = 3049 Then
        x = MsgBox("The file is corrupted or isn't a Microsoft Access database.", 0, "The Practice Manager")
        DoCmd GoToControl "dbpath"
        Exit Function
    End If
    x = MsgBox("ERROR: " & Error(Err), 0, "The Practice Manager")
    DoCmd SetWarnings True
    Exit Function
End Function

 

 

 

 

DFAS User <dfas...@dfas.mil> wrote in message news:37C14983...@dfas.mil...