Select Multiple Backend Databases-Need to Add New Links

[ekwstats]

I have a great routine that allows me to select diffent backend databases to link to. I also use it to check for the backend database at the time of start up and if it's missing the routine links to a default backend database.
The problem is...if the computer crashes or the user manually end tasks the program for some reason in the middle of the relink, the next time the person logs in they will be short a table or two so any subsequent relinks will always be short a table because it's no longer part of AllTables.
This is the jist of the routine/function.

Dim obj As AccessObject, dbs As Object

Set dbs = Application.CurrentData

For Each obj In dbs.AllTables
strTableName = obj.name
If Not (Left(strTableName, 4) = "MSys" Or strTableName = "stblSN" Or strTableName = "tblDefaults" Or strTableName = "tblSoftware") Then
DoCmd.DeleteObject acTable, strTableName
DoCmd.TransferDatabase acLink, "Microsoft Access", strFilename, _
acTable, strTableName, strTableName
End If
Next obj

My thoughts were to have the routine delete all the links then go out to the selected backend database and relink to all of the tables in that selected backend rather than doing the transferdatabase. I can't figure out how to do this though.

 

[MoLaker]

Here's a routine I used in one of my old apps. It is coded for linking to a SQL Server using a system DSN, but it should give you some ideas. I removed all but 2 tables, but you can add as many tables as is needed. Instead of depending upon AllTables, you hard code the tables. It is necessary to delete the links first or otherwise you duplicate table links by adding the table name with a sequencing number at the end. The OnError - Resume Next handles cases where the link has been dropped and does not exist. Then I set it back to 0 to make sure the tables relink w/o error.

Public Function ODBCRelink()
' deletes all odbc table links then recreates links
On Error Resume Next
    Dim dbs As Database
    Set dbs = CurrentDb
    dbs.TableDefs.Delete "AppVersion"
    dbs.TableDefs.Delete "UpdateResult"
    
    On Error GoTo 0
    
    DoCmd.TransferDatabase acLink, "ODBC Database", _
    "ODBC;DSN=CRAMS;DATABASE=CRAMS;UID=access1;PWD=access1", _
    acTable, "AppVersion", "AppVersion", , True
    
    DoCmd.TransferDatabase acLink, "ODBC Database", _
    "ODBC;DSN=CRAMS;DATABASE=CRAMS;UID=access1;PWD=access1", _
    acTable, "UpdateResult", "UpdateResult", , True
    
End Function

How you direct the routine to which table could be done with multiple DSN's.

This next routine I got from somewhere a long time ago and can't give proper credit, but it will create a DSN on the fly if it doesn't exist already.

Function Set_SysDSN(DSN_name As String, Server_name As String, Dbase_name As String)
' Creates System DSNs
' Parameters
' DSN_name: name of DSN
' Server_name: name of server
' Dbase_name: name of database
' DSN will be created in NT authentication mode

    '  Look for System Data Source Name.
    
    Dim lngKeyHandle As Long
    Dim lngResult As Long
    Dim lngCurIdx As Long
    Dim strValue As String
    Dim classValue As String
    Dim timeValue As String
    Dim lngValueLen As Long
    Dim classlngValueLen As Long
    Dim lngData As Long
    Dim lngDataLen As Long
    Dim strResult As String
    Dim DSNfound As Long
    Dim syscmdresult As Long

    syscmdresult = SysCmd(acSysCmdSetStatus, "Looking for System DSN " & DSN_name & " ...")
    
    '  Open the registry key that contains all of the
    '  System Data Source Names.
    
    lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
            "SOFTWARE\ODBC\ODBC.INI", _
             0&, _
             KEY_READ, _
             lngKeyHandle)

    If lngResult <> ERROR_SUCCESS Then
        MsgBox "ERROR:  Cannot open the registry key HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI." & vbCrLf & vbCrLf & _
               "Please make sure that ODBC and the SQL Server ODBC drivers have been installed." & vbCrLf & _
               "Contact call your System Administrator for more information."
        syscmdresult = SysCmd(acSysCmdClearStatus)
        Set_SysDSN = -1
    End If
    
    ' Look among all of the possible system data source
    ' names for the one wanted

    lngCurIdx = 0
    DSNfound = False
    
    Do
        lngValueLen = 512
        classlngValueLen = 512
        strValue = String(lngValueLen, 0)
        classValue = String(classlngValueLen, 0)
        timeValue = String(lngValueLen, 0)
        lngDataLen = 512

        lngResult = RegEnumKeyEx(lngKeyHandle, _
                                lngCurIdx, _
                                strValue, _
                                lngValueLen, _
                                0&, _
                                classValue, _
                                classlngValueLen, _
                                timeValue)
        lngCurIdx = lngCurIdx + 1

    If lngResult = ERROR_SUCCESS Then
    
    ' Is this the System Data Source Name?
    
        If strValue = DSN_name Then
      
        '  Delete it to allow creating a new one.
        
            syscmdresult = SysCmd(acSysCmdClearStatus)
            DSNfound = SQLConfigDataSource(0, _
                                ODBC_REMOVE_SYS_DSN, _
                                "SQL Server", _
                                "DSN=" & DSN_name)
        End If
      
    End If

    Loop While lngResult = ERROR_SUCCESS And Not DSNfound
    
    Call RegCloseKey(lngKeyHandle)
    DSNfound = False
    If Not DSNfound Then
    
        '  Create a new DSN on the fly
        
        syscmdresult = SysCmd(acSysCmdSetStatus, "Creating System DSN " & DSN_name & "...")
        
        lngResult = SQLConfigDataSource(0, _
           ODBC_ADD_SYS_DSN, _
           "SQL Server", _
           "DSN=" & DSN_name & Chr(0) & _
           "Network=DBMSSOCN" & Chr(0) & _
           "Server=" & Server_name & Chr(0) & _
           "Database=" & Dbase_name & Chr(0) & _
           "Trusted_Connection=No" & Chr(0) & _
           "UseProcForPrepare=Yes" & Chr(0) & _
           "Description=" & Dbase_name & " Database" & Chr(0) & Chr(0))
    
        If lngResult = False Then
          
            MsgBox "ERROR:  Could not create the System DSN " & DSN_name & "." & vbCrLf & vbCrLf & _
                   "Please make sure that the SQL Server ODBC drivers have been installed." & vbCrLf & _
                   "Contact your System Administrator for more information."
                   
            syscmdresult = SysCmd(acSysCmdClearStatus)
            Set_SysDSN = -1
            Exit Function
        End If
        
        syscmdresult = SysCmd(acSysCmdClearStatus)
        Set_SysDSN = 0
    End If
End Function

Once again, it was set up for SQL Server, but you can tailor it for Access.

 

[ekwstats]

I think I see what I was doing wrong in creating a new link with your example, and I guess I could manually define each table that I want the front end to link to, but I was hoping it could look loop through each table in the backend and then fill in the variables (tablename) and then link to each one in the AllTables list kind of what I did in the delete link.
Thanks