Solved

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

Posted on 2008-06-12
8
442 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
  • 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
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
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

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Most if not all databases provide tools to filter data; even simple mail-merge programs might offer basic filtering capabilities. This is so important that, although Access has many built-in features to help the user in this task, developers often n…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
Familiarize people with the process of utilizing SQL Server functions from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Ac…
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.

760 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now