Linked tables in MS Access 2003

Airtech

I am building a media management tool and starting it in Access 2003.
I have various linked tables, and have sufficient code to loop through my list of linked tables to verify that the data file specified in the link is available in the specified path.

I am trying to finish this portion of my code to handle the table(s) whose links are broken because the specified file no longer exists.

Can someone suggest how I might "re-link" a table or several table (within the same data source) through VBA? Right now the links are to other MDB data sources.

What I am trying to avoid is running the re-link routine that I have every time the program starts even when there is nothing to do, and also I do not want to re-link tables whose links are perfectly good. Doing this, wastes a lot of startup time. I have about 11 tables now, but with the prospect if that list growing, I am trying to build my program to have a more intelligient way to check each link before "re-creating" it without having to redo all of them every time.

Thanks,
CJ

Delerna

Hard to see exactly what you are doing from the description, but one thought is to arrange things so that the relinking routine runs
only when you capture an error that occurs within some VBA code because of a broken link. Hope my meaning in that statement is clear?

Need more detail to give you an idea on how to go about doing that.

Airtech

OK, here is the code I have so far, this lists the tables that are linked into a collection each is referenced by an index, and the code which will extract the table name, and its current link from that indexed entry.
Then what I do is run a check to see if the referenced file exists.
This is where I start to run into trouble. If the file exists, then I would simply keep going through the collection until I came to a table which had a link to a different back-end database. Then I would test to see if that file existed and so on. If each of the different back-end files exist, then no re-linking should occur. This should allow, my program to start relatively quickly. If one or more of the back-end tables did not exist based on what the current link says it should be, then that table should be re-linked, test the next entry and so on.

Here is my code (kind of a collection of different things), there may be stuff in here, I really do not need once this is done.

Expand|Select|Wrap|Line Numbers

 Function DataSourceTest()

'This function is a test function built to test the back-end data connectivity code

'This will be the code that will list the tables, see where they are connected and whether or not the data source is actually available
 
Dim x

Dim TableDataPath As String

Dim PathToData As String

Dim NewFile As String
 
'Get list of linked tables, and their data source

fGetLinkedTables
 
'Loop through each item in the collection of linked tables to decide what to do with it

For x = 1 To LinkedTables.Count

    Debug.Print LinkedTables.Item(x)
 
    TableDataPath = Left$(LinkedTables.Item(x), InStrRev(LinkedTables.Item(x), ";"))

    TableDataPath = Left$(TableDataPath, Len(TableDataPath) - 1)

    Debug.Print TableDataPath
 
    PathToData = GetDataPath(TableDataPath)

    Debug.Print PathToData
 
    If FileOrDirExists(PathToData) = True Then

        'Available, do nothing

    Else

        'Not available, locate the data file

        MsgBox "The back-end data source for: " & TableDataPath & " is not available." & vbCrLf & "Please locate the data source."

        NewFile = fGetMDBName(TableDataPath)

    End If

Next
 
End Function
 
Function fGetLinkedTables()

'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 LinkedTables = collTables

    Set collTables = Nothing

    Set tdf = Nothing

    Set db = Nothing

End Function
 
Public Function GetDataPath(strTable As String) As String

'On Error GoTo Err_Handler
 
'Purpose:   Return the full path of the file from the Connect property of this tabledef.

'Return:    Full path and file name for attached MDB.

'           Just the path for some other types (e.g. attached text.)

'           Zero-length string for local table (not attached), or of argument is zero-length.

'           "#Error" on error, e.g. table not found.

'Requires:  Split() function for Access 97 or earlier.
 
Dim varArray As Variant

Dim i As Integer
 
If Trim$(strTable) <> vbNullString Then

    varArray = Split(CurrentDb.TableDefs(strTable).Connect, ";")

    For i = LBound(varArray) To UBound(varArray)

        If varArray(i) Like "DATABASE=*" Then

            GetDataPath = Trim$(Mid$(varArray(i), 10))

            Exit For

        End If

    Next

End If
 
Exit_Handler:
 
    Exit Function
 
Err_Handler:
 
    'Call LogError(Err.Number, Err.Description, conMod & ".GetDataPath", strTable, False)

    'GetDataPath = "#Error"

    Resume Exit_Handler
 
End Function
 
'This function will make sure the file specified in the linked property is available

'If available, then nothing should happen, if not, then a request to locate to data files will be presented to the user
 
Function FileOrDirExists(PathName As String) As Boolean
 
     'Macro Purpose: Function returns TRUE if the specified file

     '               or folder exists, false if not.

     'PathName     : Supports Windows mapped drives or UNC

     '             : Supports Macintosh paths

     'File usage   : Provide full file path and extension

     'Folder usage : Provide full folder path

     '               Accepts with/without trailing "\" (Windows)

     '               Accepts with/without trailing ":" (Macintosh)
 
    Dim iTemp As Integer
 
     'Ignore errors to allow for error evaluation

    On Error Resume Next

    iTemp = GetAttr(PathName)
 
     'Check if error exists and set response appropriately

    Select Case Err.Number

    Case Is = 0

        FileOrDirExists = True

    Case Else

        FileOrDirExists = False

    End Select
 
     'Resume error checking

    On Error GoTo 0
 
End Function
 
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 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

Also, I do realize that the fRelinkTables function does actually to what my datsource test function is doing in part, but I am trying to get this down to just what I need.

Appreciate your help,and looking forward to your input.

Thanks,
CJ

Airtech

Also, this may not be quite as clean as it should or will be in the end, but the core functionality is what I am trying to do.

I suspect from your answer, you may have a better idea of how to handle this.

NeoPa

I'm working on something similar myself today, so I'll post something when I've worked it out if you like.

NeoPa

I found what I needed in other threads here, but I'll just link a couple of threads that got me going (Checking linked tables on startup & linked table).

The fundamental concept of relinking is to change the TableDef's .Connect string to reflect your new requirement, then call .RefreshLink for the TableDef.

The following code is a little routine I'm now using that returns the current address of the linked tables (Assumes all AccessLinked tables refer to the same database), and will optionally set them too, if a parameter is passed.

Expand|Select|Wrap|Line Numbers

 'LinkTo() Returns the name of the database that AccessLinked tables link to.

'Assumes all AccessLinked tables refer to the same database.

'Also allows caller to specify a location to change the links to (if necessary).

Public Function LinkTo(Optional ByVal strLinkDest As String = "") As String

    Dim db As DAO.Database

    Dim tdf As DAO.TableDef

    Dim intDB As Integer

    Dim strLink As String

    Dim varLinkAry As Variant
 
    Set db = CurrentDb

    For Each tdf In db.TableDefs

        With tdf

            If .Attributes And dbAttachedTable Then

                varLinkAry = Split(.Connect, ";")

                For intDB = LBound(varLinkAry) To UBound(varLinkAry)

                    If Left(varLinkAry(intDB), 9) = "DATABASE=" Then Exit For

                Next intDB

                strLink = Mid(varLinkAry(intDB), 10)

                If LinkTo = "" Then LinkTo = strLink

                If strLinkDest = "" Or strLinkDest = strLink Then Exit For

                varLinkAry(intDB) = "DATABASE=" & strLinkDest

                .Connect = Join(varLinkAry, ";")

                Call .RefreshLink

            End If

        End With

    Next tdf

End Function

NeoPa

As I found I needed to add some error handling code into this, for all but very well defined environments (IE All calls checked thoroughly beforehand for invalid links), I include the updated version. The extra length is due to the error handling code.

Expand|Select|Wrap|Line Numbers

 'LinkTo() Returns the name of the database that AccessLinked tables link to.

'Assumes all AccessLinked tables refer to the same database.

'Also allows caller to specify a location to change the links to (if necessary).

Public Function LinkTo(Optional ByVal strLinkDest As String = "") As String

    Dim db As DAO.Database

    Dim tdf As DAO.TableDef

    Dim intParam As Integer

    Dim strLink As String

    Dim varLinkAry As Variant
 
    Set db = CurrentDb

    For Each tdf In db.TableDefs

        With tdf

            If .Attributes And dbAttachedTable Then

                varLinkAry = Split(.Connect, ";")

                For intParam = LBound(varLinkAry) To UBound(varLinkAry)

                    If Left(varLinkAry(intParam), 9) = "DATABASE=" Then Exit For

                Next intParam

                strLink = Mid(varLinkAry(intParam), 10)

                If LinkTo = "" Then LinkTo = strLink

                If strLinkDest = "" Or strLinkDest = strLink Then Exit For

                varLinkAry(intParam) = "DATABASE=" & strLinkDest

                .Connect = Join(varLinkAry, ";")

                On Error Resume Next

                Call .RefreshLink

                Select Case Err.Number

                Case 3011, 3024, 3044, 3055, 7874

                    varLinkAry(intParam) = "DATABASE=" & strLink

                    .Connect = Join(varLinkAry, ";")

                    strLinkDest = "Database file (" & _

                                  strLinkDest & _

                                  ") not found"

                    Call MsgBox(strLinkDest, _

                                vbOKOnly Or vbExclamation, _

                                "LinkTo")

                    Exit For

                End Select

            End If

        End With

    Next tdf

End Function

NeoPa

By the way, while researching this I came across a very useful function AccessError(), which takes an error number and returns the associated text. It helped me select a buch of error codes that may cause this to fail due to files/objects not being where they should be. If anyone sees any others just flag them up & I'll update.

Linked tables in MS Access 2003

re: Linked tables in MS Access 2003

re: Linked tables in MS Access 2003

re: Linked tables in MS Access 2003

re: Linked tables in MS Access 2003

re: Linked tables in MS Access 2003

re: Linked tables in MS Access 2003

re: Linked tables in MS Access 2003

Similar Microsoft Access / VBA bytes

/bytes/development

/bytes/it

/bytes/about