A couple of notes:
1) I use a global error handler
2) My backends have all permissions removed so I use RWOP queries in the
front end.
3) I'm a beginning/intermediate programmer, so be gentle :)
Okay, here it is
Public Function RelinkToCurDir( PassedBEFile As String, FullPathProvide d As
Boolean) As Boolean
'Note, when all permissions have been removed from the backend tables
'and with RWOP, relinking will cause an error and the code must use Resume
'Next. This is by design from Microsoft. When the error is ignored,
'then the relinking will work.
'3/22/2006 NOTE: Must use On Error Resume Next at the top of the code.
Trapping
'the error in an error handler and then using Resume Next does not work.
'THIS IS EXTREMELY IMPORTANT
On Error GoTo Err_Ctrl
Dim wsBACK As DAO.Workspace
Dim dbBACK As DAO.Database
Dim BEFile As String
Dim stDocName As String
Dim db As Database
Dim tdf As TableDef
Dim X As Boolean, TableToLink As String
BEFile = PassedBEFile
'NOTE: 3/25/2006: dbBACK needs to be included. If only db is used, then all
links are included
'(about 150) and are deleted each time as each backend file is linked. By
using dbBACK, we
'get the count of the tables from the backend file.
Set wsBACK = DBEngine.Worksp aces(0)
Set dbBACK = wsBACK.OpenData base(BEFile)
Set db = CurrentDb()
On Error Resume Next
'Now link the tables
For k = dbBACK.TableDef s.Count - 1 To 0 Step -1
TableToLink = dbBACK.TableDef s(k).Name
'Delete the link if it already exists.
'Using the .Connect statement assures that only linked
'tables get deleted and not any front end tables
If fIsRemoteTable( TableToLink) Then
db.TableDefs.De lete TableToLink
Else
'Don't delete any front-end tables
'and Don't delete links that don't exist
End If
'Create the new link
Set tdf = db.CreateTableD ef(TableToLink)
'Set the properties of the new link
'and append to the tabledefs collection
tdf.SourceTable Name = TableToLink
tdf.Connect = ";DATABASE= " & BEFile
db.TableDefs.Ap pend tdf
Next k
RelinkToCurDir = True
Exit_Function: On Error Resume Next
Set db = Nothing
Set dbBACK = Nothing
Set tdf = Nothing
Exit Function
Err_Ctrl:
'This is the error where the backend can't be found. This will cause a loop
error if not
'trapped here that takes about 30 to 50 cancels to stop.
If Err.Number = 3024 Then
Resume Exit_Function
ElseIf Err.Number = 3078 Then
Resume Exit_Function
End If
DoCmd.Hourglass False
errMsgStr = ""
ctrlfnctnm = "RelinkToCurDir "
Call StartupModule_e rr(Err.Number, Err.DESCRIPTION , Err.Source,
ctrlfnctnm, errMsgStr)
Resume Exit_Function
End Function
+++++++++++++++ +++++++++++++++ +++++++++++++++ +++++++++++++++ +++++++++++++++ +++++++
Function fIsRemoteTable( strTbl As String) As Boolean
'Checks if a table is a linked table or this database table
Dim wsLOCAL As DAO.Workspace, dbLOCAL As DAO.Database, rsLOCAL As DAO.
Recordset
Dim rsLOCALFlag As Boolean
Dim strSQLLOCAL As String
On Error GoTo Exit_Sub
strSQLLOCAL = "SELECT Name FROM MSysObjects WHERE Type = 6 AND Name = '" &
strTbl & "';"
Set wsLOCAL = DBEngine.Worksp aces(0)
Set dbLOCAL = wsLOCAL.OpenDat abase(CurrentPr oject.FullName)
Set rsLOCAL = dbLOCAL.OpenRec ordset(strSQLLO CAL, dbOpenDynaset, dbSeeChanges)
rsLOCALFlag = True
If rsLOCAL.RecordC ount = 0 Then
'Local Table or doesn't exist in table
fIsRemoteTable = False
Else
'Remote table
fIsRemoteTable = True
End If
Exit_Sub: On Error Resume Next
If rsLOCALFlag = True Then
rsLOCAL.Close
Set rsLOCAL = Nothing
dbLOCAL.Close
Set dbLOCAL = Nothing
Set wsLOCAL = Nothing
rsLOCALFlag = False
End If
DoCmd.SetWarnin gs True
Exit Function
Err_Ctrl:
DoCmd.Hourglass False
If Err.Number = 3265 Then
fIsRemoteTable = False
Resume Exit_Sub
End If
errMsgStr = ""
ctrlfnctnm = "fIsRemoteTable "
Call StartupModule_e rr(Err.Number, Err.DESCRIPTION , Err.Source,
ctrlfnctnm, errMsgStr)
Resume Exit_Sub
End Function
Lyle Fairfield wrote:
>This damned MSysAccessStora ge table keeps getting linked to my front
end. I don't know why. It's the only system table that keeps getting
linked. I delete it and then my code seems to be relinking it but no
other system tables.
and your code is?
--
Message posted via AccessMonster.c om
http://www.accessmonster.com/Uwe/For...ccess/200608/1 
