Results 1 to 3 of 3
  1. #1
    2 Star Lounger
    Join Date
    Jul 2003
    Location
    Newtown, Pennsylvania, USA
    Posts
    119
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Relinking tables to multiple databases

    For a variety of reasons I have several databases that need to link to more than one other database. I found some code on Dev Ashish's site (<A target="_blank" HREF=http://www.mvps.org/access/tables/tbl0009.htm>http://www.mvps.org/access/tables/tbl0009.htm</A>) that in the introductory piece claims to do what I want. However, when I call the function from the first form to load on start-up, it gives me the option to select the database - but only one of them. For the tables that are not in the selected database I get a 'Table was not found in the database, could not refresh links' error message.

    Does anyone have any experience of using this code? How do I get it to recognize that different tables are from different databases, and then pop-up the GetOpenFile dialog?

    Alternatively, does anyone have any suggestions as to how this function can be accomplished?

    Many thanks,

    kiwi44

  2. #2
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    The Netherlands
    Posts
    216
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Relinking tables to multiple databases

    Kiwi,

    What I do in cases like this is defining a table in the application with two fields: Tablename and Location.
    On startup of the application I simply loop through that table and delete every TableName in it and relink it to the Location. Works fine and you can specify a different location for each linked table.

    Bart

  3. #3
    2 Star Lounger
    Join Date
    Jul 2003
    Location
    Newtown, Pennsylvania, USA
    Posts
    119
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Relinking tables to multiple databases

    Thanks Bart, if I understand you correctly, that would assume that you know in advance where the linked database _should_ be? How do you cope with the situation where the front-end database has been moved by the user?

    The code I have (from Dev Ashish' site) is as follows - the problem seems to be that when a table is not found, it triggers 'Case cERR_NOREMOTETABLE:', which has the line ' Resume fRefreshLinks_End'. This is not what I want it to do - I want to go back and give me the option to select another database ....
    How do I accomplish this?

    ******Code start
    Option Compare Database
    Option Explicit
    Function fRefreshLinks() As Boolean
    Dim strMsg As String, collTbls As Collection
    Dim i As Integer, strDBPath As String, strTbl As String
    Dim dbCurr As Database, dbLink As Database
    Dim tdfLocal As TableDef
    Dim varRet As Variant
    Dim strNewPath As String

    Const cERR_USERCANCEL = vbObjectError + 1000
    Const cERR_NOREMOTETABLE = vbObjectError + 2000

    On Local Error GoTo fRefreshLinks_Err

    If MsgBox("Are you sure you want to reconnect all Access tables?", _
    vbQuestion + vbYesNo, "Please confirm...") = vbNo Then Err.Raise cERR_USERCANCEL

    'First get all linked tables in a collection
    Set collTbls = fGetLinkedTables

    'now link all of them
    Set dbCurr = CurrentDb

    strMsg = "Do you wish to specify a different path for the Access Tables?"
    If MsgBox(strMsg, vbQuestion + vbYesNo, "Alternate data source...") = vbYes Then
    strNewPath = fGetMDBName("Please select a new datasource")
    Else
    strNewPath = vbNullString
    End If

    For i = collTbls.Count To 1 Step -1
    strDBPath = fParsePath(collTbls(i))
    strTbl = fParseTable(collTbls(i))
    varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl & "'....")
    If Left$(strDBPath, 4) = "ODBC" Then
    'ODBC Tables
    'ODBC Tables handled separately
    ' Set tdfLocal = dbCurr.TableDefs(strTbl)
    ' With tdfLocal
    ' .Connect = pcCONNECT
    ' .RefreshLink
    ' collTbls.Remove (strTbl)
    ' End With
    Else
    If strNewPath <> vbNullString Then
    'Try this first
    strDBPath = strNewPath
    Else
    If Len(Dir(strDBPath)) = 0 Then
    'File Doesn't Exist, call GetOpenFileName
    strDBPath = fGetMDBName("'" & strDBPath & "' not found.")
    If strDBPath = vbNullString Then
    'user pressed cancel
    Err.Raise cERR_USERCANCEL
    End If
    End If
    End If

    'backend database exists
    'putting it here since we could have
    'tables from multiple sources
    Set dbLink = DBEngine(0).OpenDatabase(strDBPath)
    'check to see if the table is present in dbLink
    strTbl = fParseTable(collTbls(i))
    If fIsRemoteTable(dbLink, strTbl) Then
    'everything's ok, reconnect
    Set tdfLocal = dbCurr.TableDefs(strTbl)
    With tdfLocal
    .Connect = ";Database=" & strDBPath
    .RefreshLink
    collTbls.Remove (.Name)
    End With
    Else
    Err.Raise cERR_NOREMOTETABLE
    End If
    End If
    Next
    fRefreshLinks = True
    varRet = SysCmd(acSysCmdClearStatus)
    MsgBox "All Access tables were successfully reconnected.", vbInformation + vbOKOnly, "Success"

    fRefreshLinks_End:
    Set collTbls = Nothing
    Set tdfLocal = Nothing
    Set dbLink = Nothing
    Set dbCurr = Nothing
    Exit Function

    fRefreshLinks_Err:
    fRefreshLinks = False
    Select Case Err
    Case 3059:

    Case cERR_USERCANCEL:
    MsgBox "No Database was specified, couldn't link tables.", _
    vbCritical + vbOKOnly, _
    "Error in refreshing links."
    Resume fRefreshLinks_End

    Case cERR_NOREMOTETABLE:
    MsgBox "Table '" & strTbl & "' was not found in the database" & _
    vbCrLf & dbLink.Name & ". Couldn't refresh links", _
    vbCritical + vbOKOnly, _
    "Error in refreshing links."
    Resume fRefreshLinks_End

    Case Else:
    strMsg = "Error Information..." & vbCrLf & vbCrLf
    strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
    strMsg = strMsg & "Description: " & Err.Description & vbCrLf
    strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
    MsgBox strMsg, vbOKOnly + vbCritical, "Error"
    Resume fRefreshLinks_End

    End Select
    End Function

    Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
    Dim tdf As TableDef
    On Error Resume Next
    Set tdf = dbRemote.TableDefs(strTbl)
    fIsRemoteTable = (Err = 0)
    Set tdf = Nothing
    End Function

    Function fGetMDBName(strIn As String) As String
    'Calls GetOpenFileName dialog
    Dim strFilter As String

    strFilter = ahtAddFilterItem(strFilter, _
    "Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
    "*.mdb; *.mda; *.mde; *.mdw")
    strFilter = ahtAddFilterItem(strFilter, _
    "All Files (*.*)", _
    "*.*")

    fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
    OpenFile:=True, _
    DialogTitle:=strIn, _
    Flags:=ahtOFN_HIDEREADONLY)
    End Function

    Function fGetLinkedTables() As Collection
    'Returns all linked tables
    Dim collTables As New Collection
    Dim tdf As TableDef, db As Database
    Set db = CurrentDb
    db.TableDefs.Refresh
    For Each tdf In db.TableDefs
    With tdf
    If Len(.Connect) > 0 Then
    If Left$(.Connect, 4) = "ODBC" Then
    ' collTables.Add Item:=.Name & ";" & .Connect, KEY:=.Name
    'ODBC Reconnect handled separately
    Else
    collTables.Add Item:=.Name & .Connect, Key:=.Name
    End If
    End If
    End With
    Next
    Set fGetLinkedTables = collTables
    Set collTables = Nothing
    Set tdf = Nothing
    Set db = Nothing
    End Function

    Function fParsePath(strIn As String) As String
    If Left$(strIn, 4) <> "ODBC" Then
    fParsePath = Right(strIn, Len(strIn) _
    - (InStr(1, strIn, "DATABASE=") + 8))
    Else
    fParsePath = strIn
    End If
    End Function

    Function fParseTable(strIn As String) As String
    fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
    End Function
    ******Code end

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •