Solved

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

Posted on 2008-06-12
8
600 Views
Last Modified: 2012-05-05
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

0
Comment
Question by:Cristal638
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
  • 2
8 Comments
 
LVL 38

Accepted Solution

by:
Jim P. earned 125 total points
ID: 21780865
Do all tables have a primary key?

If not, when relinking you need to select the "index" fields that are unique.
0
 
LVL 27

Assisted Solution

by:MikeToole
MikeToole earned 125 total points
ID: 21781124
Not sure what your actual problem is, but the attached code has been working for some years in production.
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.

The code uses a utility class CValueList,  which I've also included. It's an easy way to parse lists like connection strings and add/change/delete values in them. It's used here to compare the old value of Server to the value supplied in strServer to see if a refresh is needed.
   Dim vlConnect as New CValueList
     For Each tdf In db.TableDefs
        intTableIndex = intTableIndex + 1
        If (tdf.Attributes And dbAttachedODBC) <> 0 _
            And (Left(tdf.Name, 4) <> "~tmp") Then
            vlConnect.List = tdf.Connect
            If LCase(vlConnect.Item("Server")) <> LCase(strServer) Then
                 vlConnect.Item("Server") = strServer
                tdf.Connect = vlConnect.List
                tdf.RefreshLink
                Debug.Print tdf.Name
                ' Create pseudo indexes on views to make them updatable
                Select Case tdf.Name
                    Case "vwPAFTitle"
                        DoCmd.RunSQL "create unique index idxvwPAFTitle on vwPAFTitle(idPAFTitle);"
'                    Case "vwTitle"
'                        DoCmd.RunSQL "create unique index idxvwTitle on vwTitle(idPAFTitle, Promo_id);"
                    Case "vwTitleManager"
                        DoCmd.RunSQL "create unique index idxvwTitleManager on vwTitleManager(idPAFTitle);"
                End Select
                intLinksRefreshedCount = intLinksRefreshedCount + 1
            End If
        End If
    Next tdf
 
ValueList Class:
'local variable(s) to hold property value(s)
Private mList() As String
Private mSeparator As String 'local copy
Private mItems As Scripting.Dictionary
 
Public Property Let Separator(ByVal vData As String)
    ' Reset the list if the separator changes
    mListText = ""
    mSeparator = vData
    mSepLen = Len(mSeparator)
End Property
 
Public Property Get Separator() As String
    Separator = mSeparator
End Property
 
Public Property Let Item(ByVal Key As String, ByVal Value As String)
    Key = StrConv(Key, vbProperCase)
    If mItems.Exists(Key) Then
        mItems(Key) = Value
    Else
        mItems.Add Key, Value
    End If
End Property
 
Public Property Get Item(ByVal Key As String) As String
    Key = StrConv(Key, vbProperCase)
    Item = mItems(Key)
End Property
 
Public Property Let List(ByVal Value As String)
    Dim i As Integer, iPos As Integer, strItem As String, strName As String, strvalue As String
    Set mItems = New Scripting.Dictionary
    mList = Split(Value, mSeparator)
    For i = 0 To UBound(mList, 1)
        strItem = mList(i)
        iPos = InStr(strItem, "=")
        If iPos = 0 Then
            strName = StrConv(Trim(strItem), vbProperCase)
            strvalue = ""
        Else
            strName = StrConv(Trim(Left(strItem, iPos - 1)), vbProperCase)
            strvalue = Mid(strItem, iPos + 1)
        End If
        mItems.Add strName, strvalue
    Next i
End Property
 
Public Property Get List() As String
    Dim strList As String, obj As Object, i As Integer
    For i = 0 To mItems.Count - 1
        strList = strList & mSeparator & mItems.Keys(i)
        If Len(mItems.Items(i)) > 0 Then
            strList = strList & "=" & mItems.Items(i)
        End If
    Next i
    List = Mid(strList, 2)
End Property
 
Public Sub DeleteItem(ByVal Key As String)
    Key = StrConv(Key, vbProperCase)
    mItems.Remove Key
 
End Sub
 
Private Sub Class_Initialize()
    mSeparator = ";"
End Sub

Open in new window

0
 
LVL 2

Author Comment

by:Cristal638
ID: 21851750
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"
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 27

Expert Comment

by:MikeToole
ID: 21853597
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">
0
 
LVL 38

Expert Comment

by:Jim P.
ID: 21854940
While mine wasn't the nice solution that Mike had, it was a step in that direction.
0
 
LVL 2

Author Comment

by:Cristal638
ID: 21856030
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.
0

Featured Post

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
microsoft Accesss Basic Coding 44 109
GA Ribbon creator 9 58
Export individual report to pdf 2 38
how to get hundreds part from the number 1 29
Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
This article describes two methods for creating a combo box that can be used to add new items to the row source -- one for simple lookup tables, and one for a more complex row source where the new item needs data for several fields.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

737 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question