Solved

error 3027 No Linked Tables Querydef Updating  ?

Posted on 2007-03-22
4
278 Views
Last Modified: 2012-06-21
access 2003
I'am trying to update fields in a query through from another table.

I get runtime 3027   ?? database or table read only...
No Linked tables ?


Dim cD As String, sC As String, score, x
Dim stN As String
Dim cArr As Variant
Dim NounPos(0 To 200) As Integer
Dim tempC As String
Dim nf1 As String
Dim nf2 As String
Dim nf3 As String
Dim nf4 As String
Dim nf5 As String
'Dim strCC As Label

Dim rsCust As DAO.Recordset
Dim rsNoun As DAO.Recordset
'Dim rsNoun2 As DAO.Recordset
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim rsCore As DAO.Recordset
Dim sD As String
Dim cArrB, sB As String
Dim wdFound, scrFound As String
Dim cArrg, sG As String
Dim dbs As Database
Dim rsSql As DAO.Recordset
Dim strSql As String
Dim qd As DAO.QueryDef
Dim lb, ub As Integer
'Set qd = CurrentDb.QueryDefs("qryBruteForceResult")
Set dbs = CurrentDb
'=================================
' DECLARE RECORDSET
Set rsCust = CurrentDb.OpenRecordset("tblData")
Set rsNoun = CurrentDb.OpenRecordset("tblNounMod1", dbOpenTable)
Set rsCore = CurrentDb.OpenRecordset("tblCoreskuInformationST")

' TAKE TO FIRST RECORD
rsCust.MoveFirst
rsNoun.MoveFirst
' Start The Looping through customer input recs.
rsNoun.Index = "NOUNPHRS1"

' Trim Up The Description before running Matching
DoCmd.OpenQuery "UpdTrimDescriptionBeforeDescMatch"
Do Until rsCust.EOF
    i = 0
    If rsCust("fldDescription").Value <> "" Then
        ' split on array
        cD = rsCust("fldDescription")
        cArr = Split(cD, " ")
   
        nfound = False
        For x = LBound(cArr) To UBound(cArr)
            ' FORCING ARRAY ELEMENT TO ZERO
            ' ASSUME NOT GOING TO FIND IT
            NounPos(x) = 0
            rsNoun.Seek "=", cArr(x)
            ' Finds the Nouns IN MOUNPHRS1 FIELD
            If rsNoun.NoMatch = False Then
                ' YES WE FOUND IT
                NounPos(x) = 1
                i = i + 1
            End If
        Next
        ' IF ZERO OR MORE THAN 2 WE DON'T WANT TO HANDLE IT
        If i = 0 Then
            rsCust.Edit
            rsCust!fldDelete = "Y"
            rsCust.Update
        End If
        ' GREATER THEN 1   NOUN
        If i >= 1 Then
            For x = LBound(cArr) To UBound(cArr)
                    ' pass cArr(x) to the SQL which will
                    ' extract all the SKUS with
                    ' that noun.
                   If x = UBound(cArr) Then
                        nf1 = Trim(nf1 & Chr(39) & cArr(x) & Chr(39))
                   Else
                        nf1 = Trim(nf1 & Chr(39) & cArr(x) & Chr(39) & ",")
                   End If
            Next
            '''==============================================
Set qd = CurrentDb.QueryDefs("qryBruteForceResult")
' sql
strSql = "SELECT TOP 3 tblNounMod1.ITEM, tblNounMod1.NOUNPHRS1, tblNounMod1.NOUNPHRS2, tblNounMod1.NOUNPHRS3, tblCoreSkuInformationST.RICHTEXT, tblCoreSkuInformationST.fldFndNouns ,tblCoreSkuInformationST.fldScore,RANKLST2.COUNT,tblCoreSkuInformationST.fldDId, "
strSql = strSql & "tblCoreSkuInformationST.WWGMFRNUM, tblCoreSkuInformationST.WWGMFRNAME, tblCoreSkuInformationST.WWGDESC, tblCoreSkuInformationST.COMMENTS, "
strSql = strSql & "tblCoreSkuInformationST.REDBOOKNUM, tblCoreSkuInformationST.XREF, tblCoreSkuInformationST.SPIN, "
strSql = strSql & "tblCoreSkuInformationST.UOM, tblCoreSkuInformationST.[UOM Qty], tblCoreSkuInformationST.[Customer Willcall Qty], tblCoreSkuInformationST.[Customer Ship Qty], tblCoreSkuInformationST.ALT1, "
strSql = strSql & "tblCoreSkuInformationST.fldMfgname, tblCoreSkuInformationST.fldMfgnameOrig, tblCoreSkuInformationST.fldMfrnumST, tblCoreSkuInformationST.fldMfrnumOrigST, tblCoreSkuInformationST.fldDescription, tblCoreSkuInformationST.fldDescriptionOrig "
strSql = strSql & "FROM (tblNounMod1 INNER JOIN tblCoreSkuInformationST ON tblNounMod1.ITEM = tblCoreSkuInformationST.ITEM) INNER JOIN RANKLST2 ON tblCoreSkuInformationST.ITEM = RANKLST2.ITEMNUM "
strSql = strSql & "WHERE (((tblNounMod1.NOUNPHRS1) In (" & nf1 & "))) ORDER BY tblCoreSkuInformationST.fldScore DESC , RANKLST2.COUNT DESC;"

qd.sql = strSql
Set rsSql = dbs.Recordsets(strSql, dbOpenDynaset)
rsSql.MoveFirst

    ' prepare customer desc
    sC = UCase(Trim(rsCust("fldDescription")))
    cArr = Split(sC, " ")
    tempC = " " & sC & " "
   
    ' prepare grainger desc
    sG = UCase(Trim(rsSql("RICHTEXT")))
    cArrg = Split(sG, " ")
     
    ' prepare grainger brand
    sB = UCase(Trim(rsSql("WWGMFRNAME")))
    cArrB = Split(sB, " ")
   
   
    rsSql.MoveFirst 'Extracted Noun Loop
    Do Until rsSql.EOF  ' query loop
        score = 0
        wdFound = ""
        scrFound = 0
        ' Search into Grainger Richtext for Each customer Term
        sD = " " & Trim(rsSql("RICHTEXT")) & " "
       
        lb = LBound(cArr)
        ub = UBound(cArr)
        For x = lb To ub
            If InStr(sD, " " & cArr(x)) > 0 Then
                score = score + 5
                scrFound = score
                wdFound = wdFound & "," & cArr(x)
            End If
        Next
        ' Search into Customer Terms for Each Grainger Richtext term
        lb = LBound(cArrg)
        ub = UBound(cArrg)
        For x = lb To ub
            If InStr(sC, " " & cArrg(x)) > 0 Then
                score = score + 5
                scrFound = score
                wdFound = wdFound & "," & cArrg(x)
            End If
        Next
       
        ' search into grainger brand for each customer term
        sB = " " & Trim(rsSql("WWGMFRNAME")) & " "
        lb = LBound(cArr)
        ub = UBound(cArr)
        For x = lb To ub
            If InStr(sB, " " & cArr(x)) > 0 Then
                score = score + 5
                scrFound = score
                wdFound = wdFound & "," & cArr(x)
            End If
        Next
       
        ' search into customer terms for each grainger brand
        ' sC = " " & sC & " "
        lb = LBound(cArrB)
        ub = UBound(cArrB)
        For x = lb To ub
            If InStr(sC, " " & cArrB(x)) > 0 Then
                score = score + 5
                scrFound = score
                wdFound = wdFound & "," & cArrB(x)
            End If
        Next
       
        With rsSql    
            .Edit    '   <-------   ERROR 3027   CANNOT UPDATE DATABASE OR TABLE READONLY ?
            !fldScore = score '& "(found: " & wdFound & " )"
            !fldFndNouns = "(found: " & wdFound & " )"
            !fldDId = rsCust.Fields("fldDid").Value
            !fldMfgname = rsCust.Fields("fldMfgname").Value
            !fldMfgname = rsCust.Fields("fldMfgnameOrig").Value
            !fldMfrnumST = rsCust.Fields("fldMfrnum").Value
            !fldMfrnumOrigST = rsCust.Fields("fldMfrnumOrig").Value
            !fldDescription = rsCust.Fields("fldDescription").Value
            !fldDescriptionOrig = rsCust.Fields("fldDescriptionOrig").Value
            .Update
        End With
        'score = 0: wdFound = ""
        rsSql.MoveNext
    Loop
       'append records to tblDataAppend
   
    DoCmd.OpenQuery "ApdBruteQueryToDescMatchTable"
             '''=======================================
            'getScoreDescMatch nf1
        End If
    End If
  rsCust.MoveNext
Loop
0
Comment
Question by:fordraiders
  • 2
  • 2
4 Comments
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 18777351
try opening the recordset

change
Set rsSql = dbs.Recordsets(strSql, dbOpenDynaset)

to

Set rsSql = dbs.OpenRecordset(strSql, dbOpenDynaset)
0
 
LVL 3

Author Comment

by:fordraiders
ID: 18777885
cap,
did not have primary key on one of the query tables... really weird..
0
 
LVL 119

Accepted Solution

by:
Rey Obrero earned 500 total points
ID: 18778890
if you run qryBruteForceResult, does it give any error? results?
0
 
LVL 3

Author Comment

by:fordraiders
ID: 18781709
results yes, But again it was because one of the inner jointables did not have a primary key >

0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

It took me quite some time to sort out all the different properties of combo and list boxes available from Visual Basic at run-time. Not that the documentation is lacking: the help pages are quite thorough and well written. The problem was rather wh…
Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.

759 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