Robert_L_Ross said:
This is a weird problem, but here goes.
We have an MSAccess database linked via ODBC to our SQL server. We have
found when we distribute the 'front end' MSAccess files, we have very poor
response times - unless we delete the linked tables and re-link to them.
Our
IT department has been working on why this happens for over a month, and
we
are out of time.
I have found after deleting the tables and re-linking them, we get great
response times from SQL. Currently, I have to go to each desktop, run
code
that deletes the tables, manually re-link them using the Link Tables
dialog,
then run a code that renames the tables (removing the "dbo_" from the
front).
I need to find code that can link the tables via ODBC so we can have a
'push
button function' that will re-link the tables. I'd like to have it set up
that the DB checks for a log file (a .txt file in the same directory as
the
front end file is located)...if it doesn't find the link file, it runs the
function I am asking for, then places the log file in the local folder.
Each
time the DB opens, it would check for this log file, meaning I won't have
to
go desk-to-desk every time we do an upgrade.
Any help on the code to link the tables would be appreciated!
In my experience, deleting and re-creating the links is a very sensible
thing to do - and is especially necessary if you have made any changes to
the SQL Server data structure.
There are many slight variations on this coding, but here is an example I
wrote where the table names needed to be re-named as per your example. The
table names are hard-coded which has advantages and disadvantages, but could
easily be changed to look for existing tables in the database.
Public Function ReLinkTables() As Boolean
On Error GoTo Err_Handler
Dim strConnect As String
Dim strTableList As String
strConnect = "ODBC;Driver={SQL Server};" & _
"Server=MyServer;" & _
"Database=MyDatabase;" & _
"Uid=MyLogin;Pwd=MyPassword;"
' Table list is in pairs like "SQL_Server|Link_Table;"
strTableList = "dbo.Customer|tblCustomers;" & _
"dbo.Product|tblProducts;" & _
"db
rder|tblOrders"
If DeleteLinks(strTableList) Then
If LinkTables(strTableList, strConnect) Then
ReLinkTables = True
End If
End If
Exit_Handler:
Exit Function
Err_Handler:
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Function
Private Function LinkTables(strTableList As String, strConnect As String) As
Boolean
On Error GoTo Err_Handler
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim astrTables() As String
Dim strTwoTables As String
Dim strSqlServerTable As String
Dim strLinkTable As String
Dim lngPosition As Long
Dim lngCount As Long
Set dbs = CurrentDb
astrTables = Split(strTableList, ";")
For lngCount = 0 To UBound(astrTables())
strTwoTables = astrTables(lngCount)
lngPosition = InStr(strTwoTables, "|")
If (lngPosition > 0) And (Len(strTwoTables) > lngPosition) Then
strSqlServerTable = Mid$(strTwoTables, 1, lngPosition - 1)
strLinkTable = Mid$(strTwoTables, lngPosition + 1)
Set tdf = dbs.CreateTableDef(strLinkTable, dbAttachSavePWD)
tdf.Connect = strConnect
tdf.SourceTableName = strSqlServerTable
dbs.TableDefs.Append tdf
Set tdf = Nothing
End If
Next lngCount
LinkTables = True
Exit_Handler:
On Error Resume Next
If Not tdf Is Nothing Then
Set tdf = Nothing
End If
If Not tdf Is Nothing Then
Set dbs = Nothing
End If
Application.RefreshDatabaseWindow
Exit Function
Err_Handler:
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Function
Private Function DeleteLinks(strTableList As String) As Boolean
On Error GoTo Err_Handler
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim astrTables() As String
Dim strTwoTables As String
Dim strLinkTable As String
Dim lngPosition As Long
Dim lngCount As Long
Dim blnError As Boolean
Set dbs = CurrentDb
astrTables = Split(strTableList, ";")
For lngCount = 0 To UBound(astrTables())
strTwoTables = astrTables(lngCount)
lngPosition = InStr(strTwoTables, "|")
If (lngPosition > 0) And (Len(strTwoTables) > lngPosition) Then
strLinkTable = Mid$(strTwoTables, lngPosition + 1)
If TableExists(strLinkTable) Then
Set tdf = dbs.TableDefs(strLinkTable)
If Len(tdf.Connect) > 0 Then
dbs.TableDefs.Delete tdf.Name
Else
' This is not a linked table
MsgBox "Cannot delete table '" & strLinkTable & "'",
vbExclamation
blnError = True
End If
Set tdf = Nothing
End If
End If
Next lngCount
If Not blnError Then
DeleteLinks = True
End If
Exit_Handler:
On Error Resume Next
dbs.TableDefs.Refresh
If Not dbs Is Nothing Then
Set dbs = Nothing
End If
Application.RefreshDatabaseWindow
Exit Function
Err_Handler:
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Function
Private Function TableExists(strTableName As String) As Boolean
On Error GoTo Err_Handler
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
If tdf.Name = strTableName Then
TableExists = True
Exit For
End If
Next tdf
Exit_Handler:
On Error Resume Next
If Not dbs Is Nothing Then
Set dbs = Nothing
End If
Exit Function
Err_Handler:
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Function
