Code for forcing a relink in FE
______________________________________________

Public Function dev_TbrRelinkSQLTables()
'MsgBox "Commented out"
'Purpose  : Relink FE to tables/views in SQL Server.
'           Includes resetting any __uniqueindex indices on views to allow updates.
'Uses Globals:
'           gconSQLDB (Database Name)
'           gconSQLServer (SQL Server Name)
'DateTime : 11/7/2003 14:00
'Author:    Bill Mosca
    Dim cnn As ADODB.Connection        'NOTE:
    Dim cat As ADOX.Catalog        'Change all ADOX objects to late binding if using 2007.
    Dim tbl As ADOX.Table
    Dim idx As ADOX.Index
    Dim x As Integer
    Dim strSQL As String
    Dim aryCols()

    On Error GoTo err_PROC

    Set cnn = CurrentProject.Connection
    Set cat = New ADOX.Catalog
    cat.ActiveConnection = cnn

    For Each tbl In cat.Tables
        If tbl.Type = "PASS-THROUGH" Then
            'Retrieve local unique index if there is one for the views.
            If tbl.Indexes.Count > 0 Then
                Set idx = tbl.Indexes("__uniqueindex")
                '                If Err <> 0 Then GoTo LoopMe
            End If

            ReDim aryCols(idx.Columns.Count - 1)
            For x = 0 To UBound(aryCols)
                aryCols(x) = idx.Columns(x).Name
            Next

            'Set Connect string
            tbl.Properties("Jet OLEDB:Link Provider String") = _
                    "ODBC;DRIVER=SQL Server;SERVER=" & gconSQLServer & ";APP=Microsoft Open Database Connectivity;" _
                    & "Trusted_Connection=Yes;DATABASE=" & gconSQLDB & ";"

            strSQL = _
                    "CREATE UNIQUE INDEX " & idx.Name _
                    & " ON " & tbl.Name & "(" & Join(aryCols, ",") & ")"
            cnn.Execute strSQL
            '            CurrentDb.TableDefs(tbl.Name).RefreshLink

        End If
LoopMe:
    Next


    MsgBox "All SQL Tables/Views successfully linked."


exit_PROC:
    On Error Resume Next
    Set idx = Nothing
    Set cat = Nothing
    Set cnn = Nothing
    Exit Function

err_PROC:
    Select Case Err.Number
            'These are all caused by no index of tdf.
        Case 9, 91, 3078, 3265, -2147217908
            Resume Next
        Case -2147467259
            'Table missing from back end so drop the link and warn that compact
            'is necessary to remove temp table.
            If MsgBox(tbl.Name & " does not exist in BE." _
                    & vbNewLine & vbNewLine _
                    & "Do you want to delete the link?", _
                    vbYesNo + vbQuestion, "Missing table!") = vbYes Then
                cat.Tables.Delete tbl.Name
                MsgBox "Be sure to compact the FE when linking is finished."
            Else
                If MsgBox("Continue relinking", vbYesNo + vbQuestion) = vbNo Then Resume exit_PROC
            End If

            Resume LoopMe
        Case Else
Stop
    End Select

    Resume exit_PROC

End Function


Public Sub Reset_tblRelink_FE()
'Purpose  : Reset DesignChange table to force Front End to relink to back end.
'DateTime : 4/19/2006 12:28
'Author   : Bill Mosca
    CurrentProject.Connection.Execute _
            "INSERT INTO DesignChange(Developer) " _
            & "VALUES('" & CurrentUserName & "')"

    MsgBox "DesignChange table has been updated." _
            & vbNewLine _
            & "All Front Ends will automatically relink on opening." _
            & vbNewLine _
            & "This instance will relink when you go to main menu.", _
            vbInformation, GetSummaryInfo("Title", False)


End Sub

'*****************
'Form code:

Private Sub Form_Activate()
    DoCmd.Restore
    'Adjust size of form if Access window is smaller than form.
    DoCmd.RunCommand acCmdSizeToFitForm

    'Check if tables have changed since last Relink.
    'SQL links do not refresh automatically.
    If DMax("DateRelinked", "tblRelink") _
            < DMax("DateDesignChange", "DesignChange") Then
        Call RelinkSQLTablesDAO(False, , Me.Name)
    End If

End Sub