asked on

Linked ODBC tables are read only when connecting using non-DSN through VBA code

Hi all,
I'm using some code to re-link in some SQL Server tables using an ODBC connection, without a DSN, into MS Access 2003 SP2. It works fine, but the tables are re-linking as Read Only. Any ideas on getting them to be Read/write???

Thanks,
Dave

FYI - I did not write the code. So if it looks like crap, it's not my fault... LOL

Public Sub Refresher(DbType As String, Optional confirmationMsg As Boolean)
 
    Dim Backend As DAO.Database, FrontEnd As DAO.Database, tdf As DAO.TableDef, strConnect As String, strServer As String
    Dim strDatabase As String, intCounter As Integer, dbOdbc As DAO.Database ' Fixed DAO
    Dim sql As String, rst As DAO.Recordset, wk As DAO.Workspace, Sourcepath As String
    Dim Idx As Index, fldIndex As Field, userName, userPass, strTable As String
    
    'display message
    DoCmd.OpenForm "Please_Wait", acNormal, , , , , "Please wait while linked server table connections are refreshed"
    DoEvents
    DoEvents
    DoEvents
    
    Sourcepath = Replace(Application.CurrentDb.Properties(0), "Front", "Back")
    
    'define connection with frontend.mdb (currentdb) and backend.mdb
    Set FrontEnd = CurrentDb
    'Set Backend = DBEngine.Workspaces(0).OpenDatabase(Sourcepath)
    
    'SQL login parameters
    userName = "rostersystem"
    userPass = "rosterSys"
    
    If DbType = "SQLServer" Then ' connect to SQL
 
        sql = "Select * from local_tblTableLinks where Server <> 'Microsoft Access'"
        Set rst = FrontEnd.OpenRecordset(sql, dbOpenDynaset)        
        
        Do While rst.EOF = False
            
            'loop through tablelinks dictionary to get connection parameters for each table
            strServer = rst.Fields("Server")
            strDatabase = rst.Fields("Database")
            strTable = rst.Fields("tableName")
            strConnect = "ODBC;DRIVER={SQL Server};SERVER=" & strServer & ";DATABASE=" & strDatabase & ";UID=" & userName & ";PWD=" & userPass & ";TABLE=" & strTable
 
            'update message
            On Error GoTo errShowForm
            Forms![please_wait]![subMessage].Caption = strTable
            DoEvents
            DoEvents
            DoEvents
            On Error GoTo 0
            
            On Error GoTo errConnection
            'establish connection
            Set tdf = FrontEnd.TableDefs(rst.Fields("link_table"))
            tdf.Connect = strConnect
            tdf.RefreshLink
            On Error GoTo 0
            
            'update table with refresh date
            rst.Edit
            rst.Fields("LastRefresh") = Now()
            rst.UPDATE
            rst.MoveNext
            CurrentDb.TableDefs.Refresh
    
        Loop
    
    Else   'refresh Access tables
 
        sql = "Select * from local_tblTableLinks where Server ='Microsoft Access'"
        
            
        Set rst = FrontEnd.OpenRecordset(sql, dbOpenDynaset)
        
        Do While rst.EOF = False
        
            'update message
            On Error GoTo errShowForm
            Forms![please_wait]![subMessage].Caption = strTable
            DoEvents
            DoEvents
            DoEvents
            On Error GoTo 0
        
            'establish connection
            Set tdf = FrontEnd.TableDefs(rst.Fields("link_table"))
            tdf.Connect = ";DATABASE=" & Sourcepath
            tdf.RefreshLink
            
            'update table with refresh date
            rst.Edit
            rst.Fields("LastRefresh") = Now()
            rst.UPDATE
            rst.MoveNext
        
            FrontEnd.TableDefs.Refresh
        
        Loop
 
    End If
    
    
            'update message
            On Error GoTo errShowForm
            Forms![please_wait]![subMessage].Caption = "Complete"
            DoEvents
            DoEvents
            DoEvents
            On Error GoTo 0
    
    
    
    If confirmationMsg = True Then
        'show confirmation
        MsgBox "Server table connections are refreshed", , "Server connections"
    End If
    
    GoTo exitSub
        
errShowForm:        'if message window is not already displayed then display it
    DoCmd.OpenForm "Please_Wait", acNormal, , , , , "Please wait while linked server table connections are refreshed"
    Resume Next
    
errConnection:      'error in odbc connection
 
    MsgBox "Error " & Err & " with " & strTable & ": " & Err.Description, , "Error"
    GoTo exitSub
        
exitSub:
    'refresh tables
    FrontEnd.TableDefs.Refresh
        
    'close message window
    On Error Resume Next
    DoCmd.Close acForm, "Please_Wait", acSaveNo
    On Error GoTo 0
    
    'close objects
    Set tdf = Nothing
    rst.Close
    Set rst = Nothing
    Set Backend = Nothing
    Set dbOdbc = Nothing
End Sub

Open in new window

ASKER CERTIFIED SOLUTION

Jim P.

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

SOLUTION

MikeToole

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Cristal638

ASKER

Sorry for the delay... I was on a business trip.

Anyway, the solution that I finally went with was to add a field called "PrimaryKey" to the table that contains the relinking information. After the table has been relinked I create the index using the values in the "PrimaryKey" field.

strPKey = rst.Fields("PrimaryKey") 'the PrimaryKey field contains comma seperated values (ie. BusinessUnit_Id, Division_Id)

CurrentDb.Execute "CREATE INDEX PK" & tdf.Name & " ON " & tdf.Name & " (" & Trim(strPKey) & ") WITH PRIMARY"

MikeToole

The solution adopted was that advised in both responses to the question. Jimpen pointed out that if there was no PK a unique index needs to be created, I supplied a code sample that did just that:
<jimpen is right about the Primary Keys - Access will automatically create a local index if it finds a PK, but you have to do it yourself for any table/view that hasn't got one. There are a couple of Views in the snippet where I do this.
...
' Create pseudo indexes on views to make them updatable
Select Case tdf.Name
Case "vwPAFTitle"
DoCmd.RunSQL "create unique index idxvwPAFTitle on vwPAFTitle(idPAFTitle);"
... >
The last SQL statement does effectively the same thing as the questioner's solution:

<CurrentDb.Execute "CREATE INDEX PK" & tdf.Name & " ON " & tdf.Name & " (" & Trim(strPKey) & ") WITH PRIMARY">

Jim P.

While mine wasn't the nice solution that Mike had, it was a step in that direction.

Cristal638

ASKER

I have no issue splitting the points as a thank you for taking the time to actually look into it. I just didn't want to miss lead any future users as to what my actual solution was. I'll be happy to do whatever the moderater suggests.