Losing link?

[sturner333]

I have a database that has a frontend backend setup. I created these 2 databases from replicated databases importing all but the tables, and used the query method to transfer the tables. What happens is that this VB statement will work until I close and reopen the database:
Set rs1 = db.OpenRecordset("Notes", dbOpenDynaset)
Notes being one of the linked tables. After closing the first time I get an error message :
Runtime error 3112 , records cannot be read, no read permission on notes.
If I refresh the links everything is again ok until I close and reopen.
Thanks for the help!!!

 

[lazaridisaris]

You could use this Code to Check and relink tables


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

Dim rst As New ADODB.Recordset
Dim StrSQL As String

On Error GoTo HandleErr
' Open linked table to see if connection information is correct.
CheckLinks = True

StrSQL = "SELECT * from [" & c_CheckFileName & "];"
rst.Open StrSQL, CurrentProject.Connection, adOpenUnspecified, adLockOptimistic
If Err = 0 Then
CheckLinks = True
Else
CheckLinks = RelinkTables
End If

ExitHere:
Exit Function

HandleErr:
Select Case Err.Number
Case Else
CheckLinks = RelinkTables
End Select
' End Error handling block.
End Function

Public Function RefreshLinks(strFileName As String) As Boolean

' Refresh links to the supplied database. Return True if successful.

Dim dbs As Database
Dim tdf As TableDef

' Loop through all tables in the database.
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
' If the table has a connect string, it's a linked table.
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & strFileName
Err = 0
On Error Resume Next
tdf.RefreshLink ' Relink the table.
If Err <> 0 Then
RefreshLinks = False
Exit Function
End If
End If
Next tdf

RefreshLinks = True ' Relinking complete.

End Function

Public Function RelinkTables() As Boolean

' Tries to refresh the links to the database.
' Returns True if successful.

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

Const conMaxTables = 8
Const conNonExistentTable = 3011
Const conNotSrigou = 3078
Const conSrigouNotFound = 3024
Const conAccessDenied = 3051
Const conReadOnlyDatabase = 3027
Const conAppTitle = ".."


strSearchPath = CurrentDb().Name
Dim lLen As Integer
lLen = Len(strSearchPath)
While Mid(strSearchPath, lLen, 1) <> "\"
lLen = lLen - 1
Wend


strSearchPath = Left(strSearchPath, lLen)


' Look for the database.

If (Dir(strSearchPath & c_DataBaseFileName) <> "") Then
strFileName = strSearchPath & c_DataBaseFileName

Else
strSearchPath = "Full path where the Server side of data resides"
If (Dir(strSearchPath & c_DataBaseFileName) <> "") Then
strFileName = strSearchPath & c_DataBaseFileName
Else
' Can't find Data, so display the Open dialog box.
MsgBox "I cant Find " & c_DataBaseFileName & ". Please Find it to continue " _
& ".", vbExclamation
strFileName = FindProData(strSearchPath)
If strFileName = "" Then
strError = "Please supply a valid name"
GoTo Exit_Failed
End If
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, conNotSrigou
strError = "The table you are searching does not exist"
Case Err = conSrigouNotFound
strError = "The Database was not found."
Case Err = conAccessDenied
strError = "You do not have permitions in the DB."
Case Err = conReadOnlyDatabase
strError = "The DB is Read Only"
Case Else
strError = Err.Description
End Select

Exit_Failed:
MsgBox strError, vbCritical
RelinkTables = False


End Function

Public Function FindLinks() As String
' Refresh links to the supplied database. Return True if successful.

Dim dbs As Database
Dim tdf As TableDef

' Loop through all tables in the database.
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
' If the table has a connect string, it's a linked table.
If Len(tdf.Connect) > 0 Then
FindLinks = Mid(tdf.Connect, 11, Len(tdf.Connect) - 7)
Exit Function
End If
Next tdf


End Function

 

[PHV]

Have a look here:

http://www.mvps.org/access/tables/tbl0009.htm

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886