Modifying RefreshTableLinks Module

[Bandit]

Hi,
Can anyone see if I have errored in this code
somewhere. I followed the KB article and of course there
code works for them but when I tweak the code I do not get
the Common Dialog but instead Error '3044' or Error '3024'
depending upon how I move the database to see if I can
relink.

Thanks,
My Forehead is really flat

' Following MS KB Article - 154397
' How to Modify RefreshTalbeLinks Module


////// Step 2 /////
Public Function CheckLinks() As Boolean
' Check links to the Cyclops_be database; returns True if
links are OK.

Set rst = dbs.OpenRecordset("tblCustomers")

////// Step 3 //////
Function FindCyclops(strSearchPath) As String
' Displays the Open dialog box for the user to locate

msaof.strDialogTitle = "Where Is Cyclops_be?"


////// Step 4 /////
Public Function RelinkTables() As Boolean
' Tries to refresh the links to the Cyclops database.
' Returns True if successful.

Dim strAccDir As String
Dim strSearchPath As String
Dim strFileName As String
Dim intError As Integer
Dim strError As String

Const conMaxTables = 8
Const conNonExistentTable = 3011
Const conNotCyclops = 3078
Const conCyclopsNotFound = 3024
Const conAccessDenied = 3051
Const conReadOnlyDatabase = 3027
Const conAppTitle = "Cyclops"

' Get name of directory where MSAccess.exe is located.
strAccDir = SysCmd(acSysCmdAccessDir)

' Get the default sample database path.
If Dir(strAccDir & "Cyclops_Data\.") = "" Then
strSearchPath = strAccDir
Else
strSearchPath = strAccDir & "Cyclops_Data\"
End If

' Look for the Cyclops_be database.
If (Dir(strSearchPath & "Cyclops_be.mdb") <> "") Then
strFileName = strSearchPath & "Cyclops_be.mdb"
Else
' Can't find Cyclops_be, so display the Open
dialog box.
MsgBox "Can't find linked tables in the Cyclops_be
database. You must locate Cyclops_be in order to use " _
& conAppTitle & ".", vbExclamation
strFileName = FindCyclops(strSearchPath)
If strFileName = "" Then
strError = "Sorry, you must locate Cyclops_be
to open " & conAppTitle & "."
GoTo Exit_Failed
End If
End If

' Fix the links.
If RefreshLinks(strFileName) Then
RelinkTables = True
Exit Function
End If

' If it failed, display an error.
Select Case Err
Case conNonExistentTable, conNotCyclops
strError = "File '" & strFileName & "' does not
contain the required Cyclops_be tables."
Case Err = conNCyclopsNotFound
strError = "You can't run " & conAppTitle & "
until you locate the Cyclops_be database."
Case Err = conAccessDenied
strError = "Couldn't open " & strFileName & "
because it is read-only or located on a read-only share."
Case Err = conReadOnlyDatabase
strError = "Can't relink tables because " &
conAppTitle & " is read-only or is located on a read-only
share."
Case Else
strError = Err.Description
End Select

Exit_Failed:
MsgBox strError, vbCritical
RelinkTables = False

End Function

 

[Douglas J. Steele]

Take a look at http://www.mvps.org/access/tables/tbl0009.htm at "The Access
Web" for an approach that does work.