Updating links from Access 2003 to Access 2007

[softhemc]

Some time ago I migrated an Access 97 database to Access 2003. The database consists of a front-end mde and 6 back-end mdbs (containing approx 150 to 200 tables that need to be linked to the mde). This part of the migration caused absolutely no problems as none of the links were broken.

I now need to migrate to Access 2007 and to move to the accdb and accde formats. The conversions have all worked fine, but none of the links are now valid as they refer to completely different files.

Is there a programmatic way in which I can update these, as opposed to doing them manually?


Thanks in advance for any assistance that you can provide.

 

[MajP]

I have code that allows me to bring up a file browser and point to a backend and it relinks all found tables. Then allows you to keep picking back-ends until all tables are relinked. Do you still need this code?

 

[tallest1]

I have been dealing with the same issue for 3 weeks now. Below is a simplified version of my code but it only works some of the time. I get a "Object Invalid or No Longer Set" error that halts the process and prevents some links from getting updated. I know the cause comes from a reference to objTbl which gets modified thus changing the table reference but I don't know how to fix it... I was about to post a question but it seems we're in the same boat.

[!]**To all experts skimming this thread: This code does not work smoothly. Additional help is needed** [/!]

Function ConvertLinks(strFileSpec As String, Optional strFilePass As String)
 
    Const srtImex = "IMEX"
    Const strMapi = "MAPILEVEL="
 
    On Error GoTo ErrorHandler
 
    'Define the ADOX Catalog object.
    Dim objCat As New ADOX.Catalog
 
   'Define the ADOX Table object.
    Dim objTbl As ADOX.Table

    'Database name of the linked table.
'    Dim strFilename As String

    'Path and database name of the linked table.
    Dim strFullName As String
    Dim blnIsMapi As Boolean
    Dim blnIsImex As Boolean
    Dim blnIsTemp As Boolean

 
  
' Setting a connection using the given Filepath
 
    objCat.ActiveConnection = _
        "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Persist Security Info=False;" & _
        "Data Source='" & strFileSpec & "'"
 
' Applying password to a table depending on user input 
'   If Not IsNull(strFilePass) Then
'    objCat.ActiveConnection.Properties("Jet OLEDB: Database Password") = strFilePass
'   End If
 
'Loop through the linked table collection and update the each one.

    For Each objTbl In objCat.Tables
 
'Verify that the table is a linked table.
        If objTbl.Type = "LINK" = True Then
            blnIsTemp = objTbl.Properties("Temporary Table") Or Left(objTbl.Name, 1) = "~"
            blnIsImex = (InStr(1, objTbl.Properties("Jet OLEDB:Link Provider String"), srtImex, vbTextCompare) > 0)
            blnIsMapi = (InStr(1, objTbl.Properties("Jet OLEDB:Link Provider String"), strMapi, vbTextCompare) > 0)
 
 
'Verify that the table is a Jet table.
            If Not blnIsTemp And Not blnIsImex And Not blnIsMapi Then
                strFullName = objTbl.Properties("Jet OLEDB:Link Datasource")
'               strFilename = Mid(strFullName, InStrRev(strFullName, "\", _
'                            Len(strFullName)) + 1, Len(strFullName))


'                Determine whether the database exists.
                If DoesFileExist(Replace(strFullName, ".mdb", ".accdb")) = True Then
                     strFullName = Replace(strFullName, ".mdb", ".accdb")
                End If
 
'               I eventually get an error from the the line below
                     objTbl.Properties("Jet OLEDB:Link Datasource") = strFullName

        End If
 
 
    Next
 
        MsgBox ("The links were not successfully updated." & vbCrLf & "Please verify your table links.", vbExclamation)
 
ExitHandler:
     Exit Function
 
ErrorHandler:
MsgBox ("File Path: " & strFileSpec)
MsgBox ("Link Table Path: " & strFullName)
MsgBox ("Error: " & Err.Description)
 
    Resume ExitHandler
 
End Function

 

[MajP]

Although your code looks similar, I have success in the following code
mdlRelinkUtilities

Option Compare Database
Option Explicit

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 linkToMaster()
   On Error GoTo errLbl:
    strPath = DLookup("BElocation", "tblDefault")
    ReProcessTables
    Exit Sub
errLbl:
   Call ErrHandler(Err.Number, Err.Description, "LinkToMaster")
End Sub

Public Sub linkToReplica()
  MsgBox "Pick the location of your replica database.", vbInformation, "Find Replica"
  strPath = fGetFileName()
  ReProcessTables
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

In the above code I was allowing the user to link to a master backend or link to a local replica and switch between the two. The procedure fGetFileName just calls a file browser and returns the path to a backend. Add your own code for the file browser here, unless you want me to post.

See if that helps.

 

[MajP]

I also have a hidden form at startup that verifies my links and allows the user to relink to the back end/s

frmLink

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

 

[MajP]

Also if you did not figure it out the procedures linkToMaster and linkToReplica show how to call the procedures.

 

[softhemc]

MajP and tallest1

Thanks both for your offerings.

As there were only 6 databases, I did it manually in the end. It only took a few minutes, whereas I was expecting it to take ages.

Thanks again