Refresh the links of tables to the backend SQL server 1

[kavya]

Hi,

I am looking for a method that i can hard code a program to refresh the links to their appropriate DSN the backend being the SQL server. Instead of going to the users desktops each time when a change is made to the database and then refreshing the links through tools and then add-ins and linked table manager. All this is assuming that the userdesktops have their appropriate DSN created already.

Thanks a lot in advance.
Regards

 

[rewdee]

Here the popular code from the net that I've only slightly modified:

Function RefreshLinks() As Boolean
Dim strMsg As String, collTbls As Collection
Dim i As Integer, sTbl As String, sDBPath As String
Dim dbCurr As Database, dbLink As Database
Dim tdfLocal As TableDef
Dim iTblNumber As Integer

Const cFILE_NOT_FOUND = vbObjectError + 1000
Const cNO_REMOTE_TABLE = vbObjectError + 2000
sDBPath = DLookup("[BackendPath]", "Admin")

    On Local Error GoTo RefreshLinks_Err

    'First get all linked tables in a collection
    Set collTbls = GetLinkedTables
    
    'first make sure we have a valid path to remote database
    If Len(Dir(sDBPath)) = 0 Then Err.Raise cFILE_NOT_FOUND
    Set dbLink = DBEngine(0).OpenDatabase(sDBPath)
    
    'now link all of them
    Set dbCurr = CurrentDb
    
    iTblNumber = collTbls.Count
    For i = iTblNumber To 1 Step -1
        sTbl = ParseTable(collTbls(i))
        
        If IsRemoteTable(dbLink, sTbl) Then
            'everything's ok, reconnect
            Set tdfLocal = dbCurr.TableDefs(sTbl)
            With tdfLocal
                .Connect = ";Database=" & sDBPath
                .RefreshLink
                collTbls.Remove (.Name)
            End With
        Else
            Err.Raise cNO_REMOTE_TABLE
        End If
    Next
    RefreshLinks = True
    
RefreshLinks_End:
    Set collTbls = Nothing
    Set tdfLocal = Nothing
    Set dbLink = Nothing
    Set dbCurr = Nothing
    Exit Function
RefreshLinks_Err:
    RefreshLinks = False
    Select Case Err
        Case 3059:

        Case cFILE_NOT_FOUND:
            MsgBox "The Path to file: " & sDBPath & ", couldn't link tables.", _
                    vbCritical + vbOKOnly, _
                    "Error in refreshing links."
            Resume RefreshLinks_End
        Case cNO_REMOTE_TABLE:
            MsgBox "Table '" & sTbl & "' was not found in the database" & _
                    vbCrLf & dbLink.Name & ". Couldn't refresh links", _
                    vbCritical + vbOKOnly, _
                    "Error in refreshing links."
            Resume RefreshLinks_End
        Case Else:
            strMsg = "Error Information..." & vbCrLf & vbCrLf
            strMsg = strMsg & "Function: RefreshLinks" & vbCrLf
            strMsg = strMsg & "Description: " & Err.description & vbCrLf
            strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
            MsgBox strMsg, vbOKOnly + vbCritical, "Error"
            Resume RefreshLinks_End
    End Select
End Function

Private Function IsRemoteTable(dbRemote As Database, sTbl As String) As Boolean
Dim tdf As TableDef
    On Error Resume Next
    Set tdf = dbRemote.TableDefs(sTbl)
    IsRemoteTable = (Err = 0)
    Set tdf = Nothing
End Function


Private Function GetLinkedTables() As Collection
'Returns all linked tables
    Dim collTables As New Collection
    Dim tdf As TableDef
    CurrentDb.TableDefs.Refresh
    For Each tdf In CurrentDb.TableDefs
        With tdf
            If Len(.Connect) > 0 Then collTables.Add Item:=.Name & .Connect, Key:=.Name
        End With
    Next
    Set GetLinkedTables = collTables
    Set collTables = Nothing
    Set tdf = Nothing
End Function

Private Function ParsePath(sIn As String) As String
'Returns the path to the database by stripping the
'prefix "DATABASE=" from the connect prperty
    If Left$(sIn, 4) <> &quot;ODBC&quot; Then
        ParsePath = Right(sIn, Len(sIn) _
                        - (InStr(1, sIn, &quot;DATABASE=&quot;) + 8))
    Else
        ParsePath = sIn
    End If
End Function

Private Function ParseTable(sIn As String) As String
'strips everything after the &quot;;&quot; to get the table name
    ParseTable = Left$(sIn, InStr(1, sIn, &quot;;&quot;) - 1)
End Function

You'll need to make some small adjustments if this is an Access 2000 app. The simplest way to use this code in Access 2000 is to ensure that a reference (->tools->references) is made to your DAO versions (Microsoft DAO 3.x Object Library) and make sure the reference is ahead of any reference to ADO (Microsoft ActiveX Data Objects 3.x).

Hope this helps,
Rewdee

 

[kavya]

Hi Rewdee,

Thanks for your reply and time.It is a really big program. But I have a question, please don't curse me for this,
I saw that you are using the backend path, is their a way that I can hard code the program using DSN that are already created instead the backend path that is the path of the server. Please let me know.

Thanks again.

 

[rewdee]

Here's some code I used to reconnect some Oracle tables. I hard coded the table names in an array. If you want to dynamically check the tables that are currently linked then you will have to iterate through the tabledefs collection as in my first post. Here's code when using a DSN:

Public Function RefreshLinks() As Boolean
    Dim strMsg As String
    Dim db As Database
    Dim tdfLocal As TableDef
    Dim varTblArray As Variant
    Dim varTblItem As Variant
    
    'ODBC connection string
    Const cODBCCONNECTION As String = "DSN=Camp Data;DBQ=OSRSPRD.WORLD;DBA=R;APA=T;PFC=1;TLO=0;"
    Set db = CurrentDb
    'On Local Error GoTo RefreshLinks_Err
    
    'iterate throught the hard coded tables
    varTblArray = Array("CAMP_CHARGES", "CAMP_CONTRACTOR", "CAMP_DEPT_EQUIVALENCY", "CAMP_MANUAL_CHARGES", "CAMP_CHARGE_TYPE")
    For Each varTblItem In varTblArray
        'reconnect
         Set tdfLocal = db.TableDefs(CStr(varTblItem))
         With tdfLocal
             .Connect = cODBCCONNECTION
             .RefreshLink
         End With
    Next varTblItem
            
    RefreshLinks = True
        
RefreshLinks_End:
        Set tdfLocal = Nothing
        Exit Function
RefreshLinks_Err:
    'detailed error message
        strMsg = "Error Information..." & vbCrLf & vbCrLf
        strMsg = strMsg & "Function: RefreshLinks" & vbCrLf
        strMsg = strMsg & "Description: " & err.Description & vbCrLf
        strMsg = strMsg & "Error #: " & Format$(err.Number) & vbCrLf
        MsgBox strMsg, vbOKOnly + vbCritical, "Error"
        WriteErrorLog err.Number, err.Description, Now, "Refresh Links"
        Resume RefreshLinks_End
End Function

Hope this helps,
Rewdee

 

[kavya]

Thanks a lot, for eg could you explain me what is

DBQ, DBA, APA, PFC, TLO may be they are used for oracle database rigght.

Thanks again.