J
Jndrline
SELECT MSysObjects.Database AS Current_Link FROM MSysObjects WHERE ((
(MSysObjects.ForeignName)='tbl_Audit') AND ((MSysObjects.Type)=6));
...shows \\pathname\backend_db.mdb,
whereas the Linked Table Manager, because of a botched earlier script, shows \
\pathname\backend_db.mdb\tablename
Should I be using something other than MSysObjects.Database?
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`
If it helps, here's what I'm doing:
Option Compare Database
Public Function onopen()
' Maximize Application
Application.RunCommand acCmdAppMaximize
' Set Links
Dim strOldLink As String
Dim strNewLink As String
' OLD LINK (system generated)
' Create sys_linkcurrent
DoCmd.SetWarnings False
DoCmd.RunSQL ("SELECT MSysObjects.Database AS Current_Link INTO
sys_linkcurrent FROM MSysObjects WHERE (((MSysObjects.ForeignName)
='tbl_Audit') AND ((MSysObjects.Type)=6));")
DoCmd.SetWarnings True
strOldLink = DLookup("Current_Link", "sys_linkcurrent")
' NEW LINK (user entered)
' From sys_linkpath
strNewLink = DLookup("Path", "sys_linkpath")
If Right(strNewLink, 1) = "\" Then
strNewLink = strNewLink & "CAT_BE.mdb"
Else
strNewLink = strNewLink & "\CAT_BE.mdb"
End If
' Check Links
If True = False Then
' Test
MsgBox strOldLink & vbNewLine _
& strNewLink
ElseIf strNewLink = strOldLink Then
' Open Switchboard
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "switchboard"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Else
' Relink Tables
Call sLinkTables
End If
End Function
Public Sub sLinkTables()
On Error GoTo err_sLinkTables
Dim cnnLocal As DAO.Database
Dim rstSharedTables As DAO.Recordset
Dim strDataMDB As String
Dim strDataMDBPath As String
Dim db As DAO.Database, td As DAO.TableDef
Dim intTotalTbls As Integer
Dim intCurrTbl As Integer
Dim strCurrTable As String
Dim strAppPath As String
Dim strLinkedTables As String
Dim pos1 As Integer, pos2 As Integer, strMaintenanceDirPath As String
On Error GoTo err_sLinkTables
MsgBox "The database will automatically close after the tables have been
relinked."
Set cnnLocal = CurrentDb
'Gets the path of the data directory for the application
strDataMDBPath = DLookup("Path", "sys_linkpath")
'Get the directory of the back end database
If Right(strDataMDBPath, 1) = "\" Then
strDataMDB = strDataMDBPath & "CAT_BE.mdb"
Else
strDataMDB = strDataMDBPath & "\CAT_BE.mdb"
End If
'if the back_end database cannot be found in its expected location, the
user will be prompted to find it
If Dir(strDataMDB) = "" Then
strDataMDB = GetOpenFile(strDataMDBPath, "I can not locate the Back-
end database file, please find CAT_BE.mdb for me.", "Access")
If strDataMDB = "" Then
Access.Quit
End If
End If
' Create a table of linked table names: "sys_linkedtables"
DoCmd.SetWarnings False
DoCmd.RunSQL ("SELECT MSysObjects.Name AS Shared_Table_Name INTO
sys_linkedtables FROM MSysObjects WHERE (((MSysObjects.Type)=6));")
DoCmd.SetWarnings True
'Get the total number of linked tables, then display the progress meter
strLinkedTables = "SELECT MSysObjects.Name AS Shared_Table_Name FROM
MSysObjects WHERE (((MSysObjects.Type)=6));"
Set rstSharedTables = cnnLocal.OpenRecordset("sys_linkedtables")
rstSharedTables.MoveLast
intTotalTbls = rstSharedTables.RecordCount
rstSharedTables.MoveFirst
SysCmd acSysCmdInitMeter, "Linking tables, please wait...", intTotalTbls
Set db = CurrentDb
intCurrTbl = 1
Do Until rstSharedTables.EOF
'update the progress meter
SysCmd acSysCmdUpdateMeter, intCurrTbl
'attempt to open the current link
On Error Resume Next
strCurrTable = rstSharedTables!Shared_Table_Name
db.TableDefs.Delete strCurrTable
On Error GoTo err_sLinkTables
Set td = db.CreateTableDef(rstSharedTables!Shared_Table_Name)
With td
.Connect = ";database=" & strDataMDB
.SourceTableName = rstSharedTables!Shared_Table_Name
End With
db.TableDefs.Append td
Set td = Nothing
rstSharedTables.MoveNext
intCurrTbl = intCurrTbl + 1
Loop
Set cnnLocal = Nothing
MsgBox "Table links has been successfully updated." & vbNewLine _
& "The Database will now close.", vbOKOnly + vbInformation, "Update
Complete"
Access.Quit
Exit_sLinkTables:
SysCmd acSysCmdRemoveMeter
Exit Sub
err_sLinkTables:
MsgBox Err.Description
Resume Exit_sLinkTables
End Sub
(MSysObjects.ForeignName)='tbl_Audit') AND ((MSysObjects.Type)=6));
...shows \\pathname\backend_db.mdb,
whereas the Linked Table Manager, because of a botched earlier script, shows \
\pathname\backend_db.mdb\tablename
Should I be using something other than MSysObjects.Database?
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`
If it helps, here's what I'm doing:
Option Compare Database
Public Function onopen()
' Maximize Application
Application.RunCommand acCmdAppMaximize
' Set Links
Dim strOldLink As String
Dim strNewLink As String
' OLD LINK (system generated)
' Create sys_linkcurrent
DoCmd.SetWarnings False
DoCmd.RunSQL ("SELECT MSysObjects.Database AS Current_Link INTO
sys_linkcurrent FROM MSysObjects WHERE (((MSysObjects.ForeignName)
='tbl_Audit') AND ((MSysObjects.Type)=6));")
DoCmd.SetWarnings True
strOldLink = DLookup("Current_Link", "sys_linkcurrent")
' NEW LINK (user entered)
' From sys_linkpath
strNewLink = DLookup("Path", "sys_linkpath")
If Right(strNewLink, 1) = "\" Then
strNewLink = strNewLink & "CAT_BE.mdb"
Else
strNewLink = strNewLink & "\CAT_BE.mdb"
End If
' Check Links
If True = False Then
' Test
MsgBox strOldLink & vbNewLine _
& strNewLink
ElseIf strNewLink = strOldLink Then
' Open Switchboard
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "switchboard"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Else
' Relink Tables
Call sLinkTables
End If
End Function
Public Sub sLinkTables()
On Error GoTo err_sLinkTables
Dim cnnLocal As DAO.Database
Dim rstSharedTables As DAO.Recordset
Dim strDataMDB As String
Dim strDataMDBPath As String
Dim db As DAO.Database, td As DAO.TableDef
Dim intTotalTbls As Integer
Dim intCurrTbl As Integer
Dim strCurrTable As String
Dim strAppPath As String
Dim strLinkedTables As String
Dim pos1 As Integer, pos2 As Integer, strMaintenanceDirPath As String
On Error GoTo err_sLinkTables
MsgBox "The database will automatically close after the tables have been
relinked."
Set cnnLocal = CurrentDb
'Gets the path of the data directory for the application
strDataMDBPath = DLookup("Path", "sys_linkpath")
'Get the directory of the back end database
If Right(strDataMDBPath, 1) = "\" Then
strDataMDB = strDataMDBPath & "CAT_BE.mdb"
Else
strDataMDB = strDataMDBPath & "\CAT_BE.mdb"
End If
'if the back_end database cannot be found in its expected location, the
user will be prompted to find it
If Dir(strDataMDB) = "" Then
strDataMDB = GetOpenFile(strDataMDBPath, "I can not locate the Back-
end database file, please find CAT_BE.mdb for me.", "Access")
If strDataMDB = "" Then
Access.Quit
End If
End If
' Create a table of linked table names: "sys_linkedtables"
DoCmd.SetWarnings False
DoCmd.RunSQL ("SELECT MSysObjects.Name AS Shared_Table_Name INTO
sys_linkedtables FROM MSysObjects WHERE (((MSysObjects.Type)=6));")
DoCmd.SetWarnings True
'Get the total number of linked tables, then display the progress meter
strLinkedTables = "SELECT MSysObjects.Name AS Shared_Table_Name FROM
MSysObjects WHERE (((MSysObjects.Type)=6));"
Set rstSharedTables = cnnLocal.OpenRecordset("sys_linkedtables")
rstSharedTables.MoveLast
intTotalTbls = rstSharedTables.RecordCount
rstSharedTables.MoveFirst
SysCmd acSysCmdInitMeter, "Linking tables, please wait...", intTotalTbls
Set db = CurrentDb
intCurrTbl = 1
Do Until rstSharedTables.EOF
'update the progress meter
SysCmd acSysCmdUpdateMeter, intCurrTbl
'attempt to open the current link
On Error Resume Next
strCurrTable = rstSharedTables!Shared_Table_Name
db.TableDefs.Delete strCurrTable
On Error GoTo err_sLinkTables
Set td = db.CreateTableDef(rstSharedTables!Shared_Table_Name)
With td
.Connect = ";database=" & strDataMDB
.SourceTableName = rstSharedTables!Shared_Table_Name
End With
db.TableDefs.Append td
Set td = Nothing
rstSharedTables.MoveNext
intCurrTbl = intCurrTbl + 1
Loop
Set cnnLocal = Nothing
MsgBox "Table links has been successfully updated." & vbNewLine _
& "The Database will now close.", vbOKOnly + vbInformation, "Update
Complete"
Access.Quit
Exit_sLinkTables:
SysCmd acSysCmdRemoveMeter
Exit Sub
err_sLinkTables:
MsgBox Err.Description
Resume Exit_sLinkTables
End Sub