Microsoft Access Sydney Australia

Tuesday, July 11, 2006

Refreshing links in a database.

After looking at many codes samples, most of the time you want to move the databases to a different directory and relink to the data file in that directory.

This code acheives that purpose:
Note: We use the LastInStr function for backward compatibility with older MsAccess Versions


Public Sub RefreshLinks()Dim sPath As String
Dim sOldPath As String
Dim sDatabaseName As String
Dim iPlace As Integer

sPath = Left(CurrentDb.Name, LastInStr(CurrentDb.Name, "\"))

For Each tdf In CurrentDb.TableDefs

If InStr(1, tdf.Connect, "DATABASE=") Then

iPlace = LastInStr(tdf.Connect, "\")
sOldPath = Left(tdf.Connect, iPlace)
'Relink if the paths are different

If Not (UCase(sOldPath) = UCase(";Database=" & sPath)) Then
sDatabaseName = Right(tdf.Connect, Len(tdf.Connect) - iPlace)
sNewConnectionName = ";DATABASE=" & sPath & sDatabaseName
tdf.Connect = sNewConnectionName
tdf.RefreshLink

End If

End If

Next
End Sub

Public Function LastInStr(strSearched As String, strSought As String) As Integer
On Error Resume Next

' This function finds the last instance of a character within' a string of characters and returns an integer representing' the final position of the desired character.'' Typically, this function us used to find the final "\" in' a file path string

Dim intCurrVal As Integer
Dim intLastPosition As Integer
intCurrVal = InStr(strSearched, strSought)

Do Until intCurrVal = 0
intLastPosition = intCurrVal
intCurrVal = InStr(intLastPosition + 1, strSearched, strSought)
Loop

LastInStr = intLastPosition

End Function

This code was written by Tom Bizannes
Microsoft Certified Professional
MsAccess and SQL Server Specialist in Sydney Australia
http://www.smartbiz.com.au