Hi,
I have an application deployed using the front-end and back-end method.
How do I, using ADO codes, update the link?

i.e. if the backend data's location has changed from I:\ to J:\,
what ADO codes can I use to change this link?
Currently, the only method I know is to delete the linked tables and
re-link them to the new location. Can someone suggest another way?

THanks Loads!



Scripts82

__________________
Scripts82

Here are the components of a re-linking routine originally developed by Alison Balter (I believe) that I've used a bunch before. It runs at start-up, verifies the validity of your dbs table links, and if the links aren't valid, uses the FileDialog object to allow the user to select a new backend path:

=======================================
‘ Start code behind a startup form:
=======================================

Private Sub Form_Load()
    DoCmd.Hourglass True
    Me.Visible = False ‘Hide main switchboard form
' DoCmd.OpenForm "frmSplashScreen" ‘ Display splash screen while re-linking code runs

    Call LinkTables

    DoCmd.Hourglass False

End Sub

Sub LinkTables()
    Dim varItem As Variant
    Dim strOut As String
    Dim strMsg As String
    Const conFileDialogFilePicker As Long = 3

    On Error GoTo LinkTables_Err:

    DoCmd.Hourglass True

    If Not VerifyLink Then
        If Not ReLink(CurrentProject.FullName, True) Then
            strMsg = "You must locate the backend data tables to proceed." & vbCrLf & vbCrLf
            strMsg = strMsg & "Click OK to continue."
            MsgBox strMsg, vbExclamation + vbOKOnly, "Re-Fresh Link to Backend"

            With Application.FileDialog(conFileDialogFilePicker)
                .ButtonName = "Select"
                .Title = "Choose your Database Files"
                .AllowMultiSelect = False
                .Filters.Clear
                .Filters.Add "Access databases", "*.mdb; *.mde", 1
                .FilterIndex = 1
                .Show

                If .SelectedItems.Count > 0 Then
                    For Each varItem In .SelectedItems
                        strOut = strOut & varItem & vbCrLf
                    Next varItem
                    If Not ReLink(strOut, False) Then
                        MsgBox "You cannot run this application without locating data tables"
                        DoCmd.Quit
                    End If
                Else
                    MsgBox "You cannot run this application without locating data tables"
                    DoCmd.Quit
                End If
            End With
        End If
    End If

    DoCmd.Hourglass False
    Exit Sub

LinkTables_Err:
    MsgBox "Error # " & Err.Number & ": " & Err.Description
    Exit Sub

End Sub

=======================================
‘ End code behind a startup form:
=======================================


=======================================
‘ Start code in a class module named BEInfo:
=======================================

Private pstrFullName As String
Private pstrFileName As String
Private pstrFilePath As String
Private pstrFilePathOnly As String
Private pstrDrive As String

Property Let FullName(strFullName As String)

    pstrFullName = strFullName
    pstrFilePath = pstrFullName

    Do While Right$(pstrFilePath, 1) <> "\"
        pstrFilePath = Left$(pstrFilePath, _
            Len(pstrFilePath) - 1)
    Loop

    pstrFileName = Mid$(pstrFullName, _
        Len(pstrFilePath) + 1)

    pstrFilePathOnly = Mid$(pstrFilePath, _
        Len(pstrDrive) + 1)

    pstrDrive = Left$(pstrFullName, _
        InStr(pstrFullName, ":"))

End Property

Property Get FileName() As String
    FileName = pstrFileName
End Property

Property Get FilePath() As String
    FilePath = pstrFilePath
End Property

Property Get FilePathOnly() As String
    FilePathOnly = pstrFilePathOnly
End Property

Property Get Drive() As String
    Drive = pstrDrive
End Property

Property Get Name() As String
    Name = pstrFullName
End Property

=======================================
‘ End code in a class module named BEInfo:
=======================================

=======================================
‘ Start code in a standard module:
=======================================

Option Compare Database
Option Explicit

Function VerifyLink() As Boolean
    Dim cat As ADOX.Catalog
    Dim tdf As ADOX.Table
    Dim strTemp As String

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

        On Error Resume Next

        For Each tdf In .Tables
            If tdf.Type = "LINK" Then
                strTemp = tdf.Columns(0).Name
                If Err.Number Then
                    Exit For
                End If
            End If
        Next tdf
    End With

    VerifyLink = (Err.Number = 0)

End Function

Function ReLink(strDir As String, DefaultData As Boolean) _
    As Boolean
    Dim cat As ADOX.Catalog
    Dim tdfRelink As ADOX.Table
    Dim oBEInfo As BEInfo
    Dim strPath As String
    Dim strName As String
    Dim intCounter As Integer
    Dim vntStatus As Variant

    vntStatus = SysCmd(acSysCmdSetStatus, "Updating Links")

    Set cat = New ADOX.Catalog
    Set oBEInfo = New BEInfo

    With cat
        .ActiveConnection = CurrentProject.Connection
        oBEInfo.FullName = strDir
        strPath = oBEInfo.FilePathOnly
        strName = Left(oBEInfo.FileName, InStr(oBEInfo.FileName, ".") - 1)

        On Error Resume Next
        Call SysCmd(acSysCmdInitMeter, "Linking Data Tables", .Tables.Count)

        For Each tdfRelink In .Tables
            intCounter = intCounter + 1
            Call SysCmd(acSysCmdUpdateMeter, intCounter)
            If .Tables(tdfRelink.Name).Type = "LINK" Then
                tdfRelink.Properties("Jet OLEDB:Link Datasource") = strPath & strName & IIf(DefaultData, "Data.Mdb", ".mdb")
            End If
            If Err.Number Then
                Exit For
            End If
        Next tdfRelink
    End With

    Call SysCmd(acSysCmdRemoveMeter)

    vntStatus = SysCmd(acSysCmdClearStatus)

    ReLink = (Err.Number = 0)

End Function

HTH,

Bob

Thanks. I'll go try that out!

Scripts82