MOD2000: How to Refresh Links in a Run-Time Application (291264)

MORE INFORMATION

1. Make sure you have the latest version of the Microsoft Data Access Components (MDAC) installed on your computer. MDAC can be found at the following Microsoft Web site:

   http://msdn.microsoft.com/dataaccess

2. Set a reference to Microsoft ADO Ext 2.5 (or later) for DDL and Security.
3. Create a new database and name it FrontEnd.mdb.
4. Import the Customers and Employees forms from the sample database Northwind.mdb into FrontEnd.mdb.
5. Create a new database and subfolder under the folder where the FrontEnd.mdb file is located, for example, Folder1\Backend1.mdb.
6. Import the Customer table from Northwind.mdb into Backend1.mdb.
7. Create a new database and subfolder under the folder where the FrontEnd.mdb file is located, for example, Folder2\Backend2.mdb.
8. Import the Employee table from Northwind.mdb into Backend2.mdb.
9. Open the FrontEnd.mdb database and create a new module. In the module, paste in the following code:

   Option Compare Database
   Option Explicit
   
   Private Declare Function apiSearchTreeForFile Lib "ImageHlp.dll" Alias _
           "SearchTreeForFile" (ByVal lpRoot As String, ByVal lpInPath _
           As String, ByVal lpOutPath As String) As Long
   
   
   Function RefreshLinks()
       On Error GoTo ErrorHandler
   
           
       Dim objCat As New ADOX.Catalog 'Define the ADOX Catalog Object
       Dim objTbl As ADOX.Table 'Define the ADOX Table Object
   
       Dim strSearchFolder As String 'Folder to Search in.
       Dim strFilename As String 'Db Name of the Linked Table
       Dim strFullName As String 'Path & DB Name of the Linked Table.
       Dim strSearchFile As String 'The new path of the database.
       
       Dim blnTablesNotLinked As Boolean 'Determines if links are valid
       
       'Open the catalog
       objCat.ActiveConnection = CurrentProject.Connection
       
       'Loop through the table collection and refresh the linked tables.
       For Each objTbl In objCat.Tables
           
           ' Check to make sure the table is a linked table.
           If objTbl.Type = "LINK" Then
               strFullName = objTbl.Properties("Jet OLEDB:Link Datasource")
               strFilename = Mid(strFullName, InStrRev(strFullName, "\", _
                               Len(strFullName)) + 1, Len(strFullName))
               strSearchFolder = CurrentProject.Path
               'The following line of code attempts to refresh the link.
               'If the source cannot be found an error is generated.
               'Please note that this code only checks one table to determine
               'whether or not the links are valid.
               objTbl.Properties("Jet OLEDB:Link Datasource") = strFullName
               
               If blnTablesNotLinked = False Then
                   Exit Function
               Else
                   'Set the search path to the path of the current project.
                   'The assumption is that the linked tables are located in subfolders.
                   strSearchFile = SearchFile(strFilename, strSearchFolder)
                   objTbl.Properties("Jet OLEDB:Link Datasource") = strSearchFile
               End If
           End If
       Next
       
       MsgBox "The links were successfully refreshed!!! "
   
   ExitHandler:
        Exit Function
        
   ErrorHandler:
        Select Case Err.Number
           Case -2147467259
               blnTablesNotLinked = True
               Resume Next
           Case Else
               MsgBox Err.Description & " " & Err.Number
               Resume ExitHandler
       End Select
   End Function
   
   Function SearchFile(ByVal strFilename As String, _
               ByVal strSearchPath As String) As String
       'Search the folder for first occurrence of the source databases.
       Dim strBuffer As String
       Dim lngResult As Long
       SearchFile = ""
       strBuffer = String$(1024, 0)
       lngResult = apiSearchTreeForFile(strSearchPath, strFilename, strBuffer)
       If lngResult <> 0 Then
           If InStr(strBuffer, vbNullChar) > 0 Then
               SearchFile = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
           End If
       End If
   End Function
   					

   This function checks the first linked table in the database to determine if the links are valid. If the links are not valid, the function searches for the database and refreshes the links.
10. Create a new macro with the following properties, and name it AutoExec:

       Action: RunCode
       Function Name:  RefreshLinks()
    
       Action: OpenForm
       Form Name:  Customers
    
       Action: OpenForm
       Form Name:  Employees
    					

    Note that you can also call this function in the Open event of a hidden Startup Form.
11. Build the package for the run-time application. Remember to add $(AppPath)\Folder1\ and $(AppPath)\Folder2\ to the respective installation locations of the databases on the Install Location page.
12. Deploy the run-time application.