Results 1 to 5 of 5
  1. #1
    2 Star Lounger
    Join Date
    Jan 2002
    Location
    Brugge, Belgium
    Posts
    144
    Thanks
    0
    Thanked 0 Times in 0 Posts

    relinking tables (ACCESS 2007)

    Using the code underneath, result in showing the "File Open Save dialog" as much as there are linked tables for wich the link is broken.
    Is it possible to change this code in such a manner, that the" file open Save dialog" only shows up once for all linked tables with broken link who has to be linked to the same back end.

    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 "Alle Access tabellen werden succesvol gekoppeld aan de Data databas.", _
    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 "Er werd geen Database gespecifieerd, het koppelen van de tabellen was niet mogelijk.", _
    vbCritical + vbOKOnly, _
    "Fout bij het verfrissen van de koppelingen."
    Resume fRefreshLinks_End
    Case cERR_NOREMOTETABLE:
    MsgBox "Tabel '" & strTbl & "' werd niet gevonden in de database" & _
    vbCrLf & dbLink.Name & ". Niet mogelijk de koppelingen tot stand te brengen", _
    vbCritical + vbOKOnly, _
    "Fout bij het verfrissen van de koppelingen."
    Resume fRefreshLinks_End
    Case Else:
    strMsg = "Informatie omtrent de opgetreden fout..." & vbCrLf & vbCrLf
    strMsg = strMsg & "Functie: fRefreshLinks" & vbCrLf
    strMsg = strMsg & "Omschrijving: " & Err.Description & vbCrLf
    strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
    MsgBox strMsg, vbOKOnly + vbCritical, "Fout"
    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)
    Dim objFileDialog As FileDialog
    Set objFileDialog = FileDialog(msoFileDialogOpen)
    fGetMDBName = objFileDialog

    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

  2. #2
    Super Moderator
    Join Date
    Jun 2002
    Location
    Mt Macedon, Victoria, Australia
    Posts
    3,993
    Thanks
    1
    Thanked 45 Times in 44 Posts

    Re: relinking tables (ACCESS 2007)

    I am sorry but I don't understand what you are asking.

    If you run this code, this is what I think it will do, whether the links are currently broken or not.
    <UL><LI>Display 2 confirmation messages
    <LI>Display a dialog box for you to choose a (backend) database file as a datasource
    <LI>Each currently linked table will be compared to this datasource, and any that can be found there will be relinked to point to this datasource[/list]
    Regards
    John



  3. #3
    2 Star Lounger
    Join Date
    Jan 2002
    Location
    Brugge, Belgium
    Posts
    144
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: relinking tables (ACCESS 2007)

    This code will for every table who's connect property <> 0 and for which the link isn't anymore the link it should be, display the fileSaveOpen dialog into which i have to browse to the new folder where the back-end is located, e.g. if my program has 10 attached tables, the FileSaveOpen dialog shows up 10 times.. As my program consist of many attached tables, most of them to be connected to the same back-end, filling in as much time the wright location for the backend in the dialog as there are attached tables , seems to be a too large work. Instead of this i would like to have the possibilty to let the dialog display only once, and after filling in the wright location to the back-end database,the connectstring for all attached tables be corrected one after the other.

  4. #4
    Super Moderator
    Join Date
    Jun 2002
    Location
    Mt Macedon, Victoria, Australia
    Posts
    3,993
    Thanks
    1
    Thanked 45 Times in 44 Posts

    Re: relinking tables (ACCESS 2007)

    I still don't follow I am afraid. When I try to test your code it gives me errors I can't track down.
    When I just read it, it seems to me that it should relink all tables in one loop, without prompting for each separate table.

    I attach a zip file of 3 accdb files. A Front End and two backends. There is code in there that:

    <UL><LI>Attempts to automatically relink the tables if links are broken, by looking in the same folder as the FE
    <LI>Allows you to manually relink if the automatic fails
    <LI>Allows you to change backend if you have alternate data files.[/list]The dialog box used here does display accdb files.

    Is this any help"
    Attached Files Attached Files
    Regards
    John



  5. #5
    2 Star Lounger
    Join Date
    Jan 2002
    Location
    Brugge, Belgium
    Posts
    144
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: relinking tables (ACCESS 2007)

    I thank you very much for your help, it deserves a appreciation !!!

Posting Permissions

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