Auto-Linking to multiple Database Back-Ends

[John Phelan]

I have a front-end application called, “inbusiness.mdb†and three back-ends
databases called,
“inbusinessClient_be.mdbâ€, “inbusinessFund_be.mdbâ€, and, “inbusiness_beâ€. I
created three back-ends for the potential intensive use of certain areas of
the front-end application to their back-end tables by certain type of
organizations. With the code below, (used to make future front-end updates
easier) I have experienced no problems to automatically link to a single
back-end database file whenever my software application was installed on a
client’s computer.

While the installation routine defines the location, (C:\Program
Files\InBusiness\) for the front and back-ends; I need to know if the same
code will automatically find ALL the back-ends, and not just the original,
“inbusiness_be.mdb†database file.

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
Public 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 Microsoft ADO extensibility library
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 InBusiness Data links were successfully refreshed!!! "
ExitHandler:
Exit Function
ErrorHandler:
Select Case Err.Number
Case -2147467259
blnTablesNotLinked = True
Resume Next
Case Else
MsgBox Err.Description & "Check to see if you installed the tables used for
storing data is in the default directory. " & Err.Number
Resume ExitHandler
End Select
End Function
Private Function SearchFile(ByVal strFilename As String, _
ByVal strSearchPath As String) As String
On Error GoTo ErrLine
'Search the folder for first occurrence of the source databases.
Dim strBuffer As String
Dim lngResult As Long
SearchFile = "private"
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
ExitLine:
Exit Function
ErrLine:
Resume ExitLine
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, he function searches for
the database and refreshes the links.

thanks,
John