MS Access VBA Re-Link Tables Function for versions 2000, 2002, 2003, 2007

Function RefreshLinkX( ByVal NewLTable As String , ByVal OldLTable As String ) As Boolean
   ' The Basis of this code comes right from the Microsoft Visual Basic Help File
   ' There are several changes, one being error handling
   '
   ' References: Microsoft Access 11.0 Object Library, Microsoft DAO 3.6 Object Library
   ' Set references by Clicking Tools and Then References in the Code View window
   ' Re-Links a Linked Table by deleting the Old and Linking the New
   '
   ' NewLTable: Name of the new Linked Table
   ' OldLTable: Name of the Old Linked Table
   '
   ' Returns True on success, false otherwise
   ' USAGE: RefreshLinkX "NewLTable", "OldLTable"

   On Error GoTo errhandler
   Dim dbsCurrent As Database
   Dim tdfLinked As TableDef

   ' Open a database to which a linked table can be
   ' appended.
   Set dbsCurrent = OpenDatabase(CurrentProject.path & "\VBA_Rresh_Links_FunctionSAMPLE.mdb" )

   ' Create a linked table that points to a Microsoft
   ' Microsoft Access Database.

   ' Check if are new Linked table Exsists
   If ifTableExists(NewLTable) = False Then

      ' If not Create the TableDef
      Set tdfLinked = _
            dbsCurrent.CreateTableDef(NewLTable)
   Else

      ' If so Delete it
      DeleteTable (NewLTable)
      ' and Create the TableDef
      Set tdfLinked = _
            dbsCurrent.CreateTableDef(NewLTable)
   End If

   ' Set the Connection to the Old Linked Table
   tdfLinked.Connect = _
         "MS Access;Database=" & CurrentProject.path & "\DB1.mdb"
   tdfLinked.SourceTableName = OldLTable
   dbsCurrent.TableDefs.Append tdfLinked

   ' Display contents of linked table.
   Debug.Print _
         "Data from linked table connected to first source:"
   RefreshLinkOutput dbsCurrent, OldLTable

   ' Change connection information for the linked table and
   ' refresh the connection in order to make the new data
   ' available.
   ' This will point the new Linked Table to a new Database
   ' having the same Table name as the first.

   tdfLinked.Connect = _
         "MS Access;Database=" & CurrentProject.path & "\DB2.mdb"

   tdfLinked.RefreshLink

   ' Display contents of linked table.
   Debug.Print _
         "Data from linked table connected to second source:"
   RefreshLinkOutput dbsCurrent, OldLTable

   RefreshLinkX = True 
   dbsCurrent.Close

ExitHere: 
   Set dbsCurrent = Nothing
   Set tdfLinked = Nothing 

   'Notify the user the process is complete.
   MsgBox "Refresh Links Complete"
   Exit Function

errhandler:
   'There is an error return false
   RefreshLinkX = False

   With Err
      MsgBox "Error " & .Number & vbCrLf & .Description, _
            vbOKOnly Or vbCritical, "RefreshLinkX"
   End With

   Resume ExitHere
End Function


Sub RefreshLinkOutput(dbsTemp As Database, ByVal OldLTable As String )

   Dim rstRemote As Recordset
   Dim intCount As Integer

   ' Open linked table.
   Set rstRemote = _
         dbsTemp.OpenRecordset(OldLTable)

   intCount = 0

   ' Enumerate Recordset object, but stop at 50 records.
   With rstRemote
      Do While Not .EOF And intCount < 50
         Debug.Print , .Fields( 0 ), .Fields( 1 )
         intCount = intCount + 1
         .MoveNext
      Loop
      If Not .EOF Then Debug.Print , "[more records]"
      .Close
   End With

End Sub