Changing location of linked tables for testing 2

[jmstarbuck]

thread700-1594597

Is there any easy way or utility that I can use to quickly swap between my test and production database? The linked table manager is so slow...

Also, how do you remove a table from the linked table manager? They hang around after the table is deleted and then just complicate things.

Any suggestions appreciated.
J

 

[MajP]

Put all of this in a module

Dim UnProcessed As New Collection
Public strPath As String

Public Sub AppendTables()
  On Error GoTo errLbl:
    Dim db As dao.Database, x As Variant
    Dim strTest As String
    ' Add names of all table with invalid links to the Unprocessed Collection.
    Set db = CurrentDb
    ClearAll
    For Each x In db.TableDefs
        If Len(x.Connect) > 1 And Len(Dir(Mid(x.Connect, 11))) = 0 Then
        ' connect string exists, but file does not
             UnProcessed.Add Item:=x.Name, Key:=x.Name
        End If
    Next
    Exit Sub
errLbl:
   If Err.Number = 52 Then
   MsgBox "Network not present."
   For Each x In db.TableDefs
        
        If Len(x.Connect) > 1 Then
        'MsgBox x.Name & " " & x.Connect
        ' connect string exists, but file does not
         UnProcessed.Add Item:=x.Name, Key:=x.Name
        End If
    Next
   Else
     Call ErrHandler(Err.Number, Err.Description, "Error in Appendtables")
   End If
End Sub

Public Function ProcessTables()

    Dim strTest As String
    On Error GoTo Err_BeginLink
    
    ' Call procedure to add all tables with broken links into a collection.
    AppendTables
    
    ' Test for existence of file name\directory selected in Common Dialog Control.
    strTest = strPath
    
    On Error GoTo Err_BeginLink
    If Len(strTest) = 0 Then   ' File not found.
        MsgBox "File not found. Please try again.", vbExclamation, "Link to new data file"
        Exit Function
    End If
    
    ' Begin relinking tables.
    Relinktables (strTest)
    ' Check to see if all tables have been relinked.
    CheckifComplete
    
    DoCmd.Echo True, "Done"
    If UnProcessed.Count < 1 Then
         MsgBox "Linking to new back-end data file was successful."
    Else
         MsgBox "Not All back-end tables were successfully relinked."
    End If
    
    
Exit_BeginLink:
    DoCmd.Echo True
    Exit Function
    
Err_BeginLink:
    Debug.Print Err.Number
    If Err.Number = 457 Then
        ClearAll
        Resume Next
    ElseIf Err.Number = 3043 Then
      MsgBox "Can not find the Master on the Network.  Check that you have a good network connection."
      Resume Exit_BeginLink
    Else
      Call ErrHandler(Err.Number, Err.Description, "Error in Processtables")
      Resume Exit_BeginLink
    End If
End Function

Public Sub ClearAll()
    Dim x
    ' Clear any and all names from the Unprocessed Collection.
    For Each x In UnProcessed
       UnProcessed.Remove (x)
    Next
End Sub

Public Function Relinktables(strFileName As String)

    Dim dbbackend As dao.Database, dblocal As dao.Database, ws As Workspace, x, y
    Dim tdlocal As dao.TableDef
    
    On Error GoTo Err_Relink
    
    Set dbbackend = DBEngine(0).OpenDatabase(strFileName)
    Set dblocal = CurrentDb
    
    ' If the local linked table name is found in the back-end database
    ' we're looking at, Recreate & Refresh its connect string, and then
    ' remove its name from the Unprocessed collection.
     For Each x In UnProcessed
        If Len(dblocal.TableDefs(x).Connect) > 0 Then
            For Each y In dbbackend.TableDefs
                If y.Name = x Then
                    Set tdlocal = dblocal.TableDefs(x)
                    tdlocal.Connect = ";DATABASE=" & strPath
                    tdlocal.RefreshLink
                    UnProcessed.Remove (x)
                End If
            Next
        End If
    Next

Exit_Relink:
    Exit Function

Err_Relink:
    If Err.Number = 3043 Then
      MsgBox "Can not find the Master on the Network.  Check that you have a good network connection."
      Resume Exit_Relink
    Else
     Call ErrHandler(Err.Number, Err.Description, "Error in Relinktables")
     Resume Exit_Relink
    End If
End Function

Public Sub CheckifComplete()

    Dim strTest As String, y As String, notfound As String, x
    On Error GoTo Err_BeginLink
    
    ' If there are any names left in the unprocessed collection,
    ' then continue.
    If UnProcessed.Count > 0 Then
        For Each x In UnProcessed
            notfound = notfound & x & Chr(13)
        Next
        ' List the tables that have not yet been relinked.
        y = MsgBox("The following tables were not found in " & _
        Chr(13) & Chr(13) & strPath _
        & ":" & Chr(13) & Chr(13) & notfound & Chr(13) & _
        "Select another database that contains the additional tables?", _
        vbQuestion + vbYesNo, "Tables not found")
        
        If y = vbNo Then
            Exit Sub
        End If
        
        ' Bring the Common Dialog Control back up.
        strPath = fGetFileName
        strTest = strPath
        If Len(strTest) = 0 Then   ' File not found.
            MsgBox "File not found. Please try again.", vbExclamation, _
            "Link to new data file"
            Exit Sub
       End If
       Debug.Print "Break"
       Relinktables (strTest)
    Else
       Exit Sub
    End If
    
    CheckifComplete
    
Exit_BeginLink:
    DoCmd.Echo True   ' Just in case of error jump.
    DoCmd.Hourglass False
    Exit Sub

Err_BeginLink:
    Debug.Print Err.Number
    If Err.Number = 457 Then
        ClearAll
        Resume Next
    End If
    MsgBox Err.Number & ": " & Err.Description
    Resume Exit_BeginLink

End Sub


Public Sub AppendAllTables()
    Dim db As dao.Database, x As Variant
    Dim strTest As String
    ' Add names of all table with invalid links to the Unprocessed Collection.
    Set db = CurrentDb
    If Not UnProcessed Is Nothing Then
      ClearAll
    End If
    For Each x In db.TableDefs
        If Len(x.Connect) > 1 Then
        ' connect string exists, but file does not
             UnProcessed.Add Item:=x.Name, Key:=x.Name
        End If
    Next

End Sub
Public Function ReProcessTables()

    Dim strTest As String
    On Error GoTo Err_BeginLink
    
    ' Call procedure to add all tables with broken links into a collection.
    AppendAllTables
    
    ' Test for existence of file name\directory selected in Common Dialog Control.
    strTest = strPath
    
    On Error GoTo Err_BeginLink
    If Len(strTest) = 0 Then   ' File not found.
        MsgBox "File not found. Please try again.", vbExclamation, "Link to new data file"
        Exit Function
    End If
    
    ' Begin relinking tables.
    Relinktables (strTest)
    ' Check to see if all tables have been relinked.
    CheckifComplete
    
    DoCmd.Echo True, "Done"
    If UnProcessed.Count < 1 Then
         MsgBox "Linking to new back-end data file was successful."
    Else
         MsgBox "Not All back-end tables were successfully relinked."
    End If
    
    
Exit_BeginLink:
    DoCmd.Echo True
    Exit Function
    
Err_BeginLink:
    Debug.Print Err.Number
    If Err.Number = 457 Then
        ClearAll
        Resume Next
    End If
    MsgBox Err.Number & ": " & Err.Description
    Resume Exit_BeginLink

End Function

Then you need code to change the path. My code is set up to bring up a file browser (fgetFileName) but you could hard code it as well or path in a path. I have multiple different backends And I have a simple button to change back ends that calls the below procedure.

Public Sub changeLinkPath()
  MsgBox "Pick the location of your replica database.", vbInformation, "Find Replica"
  strPath = fGetFileName()
  ReProcessTables
End Sub

 

[MajP]

I have a hidden form open when the DB opens to first check all my links are good using the above code

Private Sub Form_Open(Cancel As Integer)
   
      ' Tests a linked table for valid back-end.
      On Error GoTo Err_Form_Open
      
      Dim strTest As String, db As dao.Database
      Dim td As dao.TableDef
      DoCmd.RunCommand acCmdAppMaximize
      DoCmd.Minimize
      Me.Visible = False
      Set db = CurrentDb
      Dim lngRtn As Long
      For Each td In db.TableDefs
         If Len(td.Connect) > 0 Then   ' Is a linked table.
            On Error Resume Next   ' Turn off error trap.
            strTest = Dir(Mid(td.Connect, 11))   ' Check file name.
            On Error GoTo Err_Form_Open   ' Turn on error trap.
            If Len(strTest) = 0 Then   ' No matching file.
              lngRtn = MsgBox("Couldn't find the back-end file " & _
                  Mid(td.Connect, 11) & "." & vbCrLf & vbCrLf & "Please choose your Replica that has your data tables.", _
                  vbExclamation + vbOKCancel + vbDefaultButton1, _
                  "Can't find backend data file.")
                 If lngRtn = vbOK Then
                     strPath = fGetFileName()   ' Open prompt form.
                     If Len(strPath) > 0 Then  ' user responded, put selection into text box on form.
                       'MsgBox strPath, vbInformation, "New Path"
                       Call ProcessTables
                     Else
                       MsgBox "No Back End Data Base Selected. Exiting Application", vbExclamation, "Must Select BE database."
                       DoCmd.Quit
                     End If
                     DoCmd.Close acForm, Me.Name
                     DoCmd.OpenForm "frmLogin", , , , , acDialog
                     Exit Sub                          ' to refresh links
               Else
                  MsgBox "The linked tables can't find their source. " & _
                  "Please log onto network and restart the application."
                  Exit Sub
               End If
            End If
         End If
      Next   ' Loop to next tabledef.
      'DoCmd.Close acForm, Me.Name
      DoCmd.OpenForm "frmLogin", , , , , acDialog
Exit_Form_Open:
      Exit Sub
Err_Form_Open:
      MsgBox Err.Number & ": " & Error.Description
      Resume Exit_Form_Open
 End Sub

 

[jmstarbuck]

Thank you so much!! I really appreciate your taking the time to share your knowledge.

J

 

[MajP]

Well unfortunately only some of that code is mine, not sure where I got it from. My library of code is pretty extensive. Being a good programmer is not always knowing how to write the code, but knowing where to go find it.

 

[jsteph]

Just my two cents...

I have found that it's not as wise to "re-link". What I always do in these cases, and even in my production dbs that use ODBC-linked tables, is to have a local table storing, at a very minimum, the table names.

Then I loop through this and *delete* the tabledefs for the linked tables, and then re-create them in code, using the below chunk as the heart (assume vars are dimmed, error checking exists, etc):

Set rsTB = db.OpenRecordset("tblODBCLinkedTables")
Do until rsTB.eof
    strN = rsTB("LocalTable") 'may differ from sql-server name
    DoCmd.DeleteObject acTable, strN
    db.Tabledefs.Refresh 'not even sure if this is needed
    Set td = db.CreateTableDef(strN)
    td.SourceTableName = Trim("" & rsTB("SourceTable"))
    'below can be changed to a 'Devconnstring', etc
    strCN = rsTB("connstring") 'or put the odbc string here if not storing in tblODBCLinkedTables
    td.Connect = strCN
    td.Attributes = 131072 'dbAttachSavePWD
    db.TableDefs.Append td
    rsTB.MoveNext
Loop

So in production front-ends--even where the user will never use an alternate server location. Links can get stale as backend structural changes occur. For example if the source structure changes (new fields, new index, new defaults, new constraints, etc) you want the client's linked table to know about it even if your code will never see the new fields, etc--especially if a new column is not put at the 'end' of the table, but inserted in the middle of existing columns, and (worse) if the coder has ever used a Select * when referring to linked tables.

Depending on the number of tables, this can take a few seconds to a half a minute. If you have hundreds of linked tables I'd set this code to run at least on a weekly basis.

--Jim