Hi Guys, I have a process that before I make any changes to a DB, I do a copy of the database and an easy way to go back if anything goes wrong. As the DB is a frontend to and SQL BE, there is a frmLink, that should re-link all the tables then when completed the login form is presented.
However, when I copy the DB and then open the copied DB, the method to re-link all the tables does not work, this is the code to re-link
Code:
Private Sub LinkTables2()Dim strMessage As String
On Error GoTo LinkTables_Error
strMessage = SysCmd(acSysCmdSetStatus, "Linking SQL Server ODBC tables, please wait ...")
'DoCmd.Hourglass True
Dim db As dao.Database
Dim tdf As dao.TableDef
Dim rst As dao.Recordset
Dim strSQLServerHost As String
Dim strSQLDatabase As String
Dim strSQLLogin As String
Dim strSQLPswd As String
Dim strSQLConn As String
Set db = CurrentDb()
Set rst = db.OpenRecordset("SELECT * FROM LINKED_SERVER_TBLS;", dbOpenDynaset)
strSQLServerHost = DLookup("[HOST_NAME]", "tabServers")
strSQLDatabase = DLookup("[DATABASE_NAME]", "tabServers")
strSQLLogin = DLookup("[USER_ID]", "tabServers")
strSQLPswd = DLookup("[PASSWORD]", "tabServers")
Dim intCount As Integer
intCount = 1
'Use this code for SQL Server where you would lookup the values for strSQLServerHost, strSQLDatabase, strSQLLogin and sttrSQLPswd in your SetupGeneral like I did for MySQl above.
'
strSQLConn = "ODBC;Driver={SQL Server};Server=" & strSQLServerHost & ";Database=" & strSQLDatabase & ";Uid=" & strSQLLogin & ";Pwd=" & strSQLPswd & ";"
'SQL SERVER ODBC LINKED TABLES PROCESSING
If rst.RecordCount > 0 Then
rst.MoveFirst
Me.Repaint
'DoEvents
Do Until rst.EOF
If DCount("Name", "MSysObjects", "Name = '" & rst!LINKED_TABLE_NAME & "' and Type = 4") <> 0 Then 'The table exist
DoCmd.DeleteObject acTable, rst!LINKED_TABLE_NAME
End If
Set tdf = db.CreateTableDef(rst!LINKED_TABLE_NAME)
tdf.SourceTableName = rst!LINKED_TABLE_NAME
tdf.Connect = strSQLConn
db.TableDefs.Append tdf
db.TableDefs.Refresh
intCount = intCount + 1
If intCount <> 66 Then
Me.lblProgress.Caption = "Connecting tables " & intCount & " - Please Wait"
Me.Repaint
DoEvents
End If
rst.MoveNext
Loop
End If
' and update the config table
Dim rstConfig As dao.Recordset
Set db = CurrentDb
Set rstConfig = db.OpenRecordset("tabConfig", dbOpenTable)
rstConfig.MoveFirst
rstConfig.Edit
rstConfig("Host_Name") = strSQLServerHost
rstConfig("Database_Name") = strSQLDatabase
rstConfig.Update
Set rstConfig = Nothing
rst.Close
Set rst = Nothing
db.Close
Set db = Nothing
strMessage = SysCmd(acSysCmdClearStatus)
DoCmd.Hourglass False
On Error GoTo 0
Exit Sub
LinkTables_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure LinkTables of Module modLinkTables"
End Sub
Private Sub Form_Timer()
Call LinkTables2
Me.TimerInterval = 0
DoCmd.OpenForm "frmLogin", acNormal
DoCmd.Close acForm, "frmLink"
End Sub
So nothing has changed, it just does not start the linking process. Can anyone suggest a way in which I can get this to fire?