Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    text
    copied!<p>I have included my entire ODBC Reconnect function below. This function is predicated with the idea that I have a table called rtblODBC which stores all of the information I need to do the reconnecting. If you implement this function, you will NOT need to worry about connecting to multiple SQL databases, as that is handled smoothly with each table to be reconnected having its own connection string.</p> <p>When you get towards the end you will see that I use DAO to recreate the primary keys with db.Execute "CREATE INDEX " &amp; sPrimaryKeyName &amp; " ON " &amp; sLocalTableName &amp; "(" &amp; sPrimaryKeyField &amp; ")WITH PRIMARY;"</p> <p>If you have any questions, please ask.</p> <pre><code>Public Function fnReconnectODBC( _ Optional bForceReconnect As Boolean _ ) As Boolean ' Comments : ' Parameters: bForceReconnect - ' Returns : Boolean - ' Modified : ' --------------------------------------------------' On Error GoTo Err_fnReconnectODBC Dim db As DAO.Database Dim rs As DAO.Recordset Dim tdf As DAO.TableDef Dim sPrimaryKeyName As String Dim sPrimaryKeyField As String Dim sLocalTableName As String Dim strConnect As String Dim varRet As Variant Dim con As ADODB.Connection Dim rst As ADODB.Recordset Dim sSQL As String If IsMissing(bForceReconnect) Then bForceReconnect = False End If sSQL = "SELECT rtblODBC.LocalTableName, MSysObjects.Name, MSysObjects.ForeignName, rtblODBC.SourceTableName, MSysObjects.Connect, rtblODBC.ConnectString " _ &amp; "FROM MSysObjects RIGHT JOIN rtblODBC ON MSysObjects.Name = rtblODBC.LocalTableName " _ &amp; "WHERE (((rtblODBC.ConnectString)&lt;&gt;'ODBC;' &amp; [Connect]));" Set con = Access.CurrentProject.Connection Set rst = New ADODB.Recordset rst.Open sSQL, con, adOpenDynamic, adLockOptimistic 'Test the recordset to see if any tables in rtblODBC (needed tables) are missing from the MSysObjects (actual tables) If rst.BOF And rst.EOF And bForceReconnect = False Then 'No missing tables identified fnReconnectODBC = True Else 'Table returned information, we don't have a perfect match, time to relink Set db = CurrentDb Set rs = db.OpenRecordset("rtblODBC", dbOpenSnapshot) 'For each table definition in the database collection of tables For Each tdf In db.TableDefs 'Set strConnect variable to table connection string strConnect = tdf.Connect If Len(strConnect) &gt; 0 And Left(tdf.Name, 1) &lt;&gt; "~" Then If Left(strConnect, 4) = "ODBC" Then 'If there is a connection string, and it's not a temp table, and it IS an odbc table 'Delete the table DoCmd.DeleteObject acTable, tdf.Name End If End If Next 'Relink tables from rtblODBC With rs .MoveFirst Do While Not .EOF Set tdf = db.CreateTableDef(!localtablename, dbAttachSavePWD, !SourceTableName, !ConnectString) varRet = SysCmd(acSysCmdSetStatus, "Relinking '" &amp; !SourceTableName &amp; "'") db.TableDefs.Append tdf db.TableDefs.Refresh If Len(!PrimaryKeyName &amp; "") &gt; 0 And Len(!PrimaryKeyField &amp; "") &gt; 0 Then sPrimaryKeyName = !PrimaryKeyName sPrimaryKeyField = !PrimaryKeyField sLocalTableName = !localtablename db.Execute "CREATE INDEX " &amp; sPrimaryKeyName &amp; " ON " &amp; sLocalTableName &amp; "(" &amp; sPrimaryKeyField &amp; ")WITH PRIMARY;" End If db.TableDefs.Refresh .MoveNext Loop End With subTurnOffSubDataSheets fnReconnectODBC = True End If rst.Close Set rst = Nothing con.Close Set con = Nothing Exit_fnReconnectODBC: Set tdf = Nothing Set rs = Nothing Set db = Nothing varRet = SysCmd(acSysCmdClearStatus) Exit Function Err_fnReconnectODBC: fnReconnectODBC = False sPrompt = "Press OK to continue." vbMsg = MsgBox(sPrompt, vbOKOnly, "Error Reconnecting") If vbMsg = vbOK Then Resume Exit_fnReconnectODBC End If End Function </code></pre>
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload