Fordraiders
asked on
error 3027 No Linked Tables Querydef Updating ?
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("qryBr uteForceRe sult")
Set dbs = CurrentDb
'========================= ========
' DECLARE RECORDSET
Set rsCust = CurrentDb.OpenRecordset("t blData")
Set rsNoun = CurrentDb.OpenRecordset("t blNounMod1 ", dbOpenTable)
Set rsCore = CurrentDb.OpenRecordset("t blCoreskuI nformation ST")
' 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 "UpdTrimDescriptionBeforeD escMatch"
Do Until rsCust.EOF
i = 0
If rsCust("fldDescription").V alue <> "" 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("qryBr uteForceRe sult")
' sql
strSql = "SELECT TOP 3 tblNounMod1.ITEM, tblNounMod1.NOUNPHRS1, tblNounMod1.NOUNPHRS2, tblNounMod1.NOUNPHRS3, tblCoreSkuInformationST.RI CHTEXT, tblCoreSkuInformationST.fl dFndNouns ,tblCoreSkuInformationST.f ldScore,RA NKLST2.COU NT,tblCore SkuInforma tionST.fld DId, "
strSql = strSql & "tblCoreSkuInformationST.W WGMFRNUM, tblCoreSkuInformationST.WW GMFRNAME, tblCoreSkuInformationST.WW GDESC, tblCoreSkuInformationST.CO MMENTS, "
strSql = strSql & "tblCoreSkuInformationST.R EDBOOKNUM, tblCoreSkuInformationST.XR EF, tblCoreSkuInformationST.SP IN, "
strSql = strSql & "tblCoreSkuInformationST.U OM, tblCoreSkuInformationST.[U OM Qty], tblCoreSkuInformationST.[C ustomer Willcall Qty], tblCoreSkuInformationST.[C ustomer Ship Qty], tblCoreSkuInformationST.AL T1, "
strSql = strSql & "tblCoreSkuInformationST.f ldMfgname, tblCoreSkuInformationST.fl dMfgnameOr ig, tblCoreSkuInformationST.fl dMfrnumST, tblCoreSkuInformationST.fl dMfrnumOri gST, tblCoreSkuInformationST.fl dDescripti on, tblCoreSkuInformationST.fl dDescripti onOrig "
strSql = strSql & "FROM (tblNounMod1 INNER JOIN tblCoreSkuInformationST ON tblNounMod1.ITEM = tblCoreSkuInformationST.IT EM) INNER JOIN RANKLST2 ON tblCoreSkuInformationST.IT EM = RANKLST2.ITEMNUM "
strSql = strSql & "WHERE (((tblNounMod1.NOUNPHRS1) In (" & nf1 & "))) ORDER BY tblCoreSkuInformationST.fl dScore DESC , RANKLST2.COUNT DESC;"
qd.sql = strSql
Set rsSql = dbs.Recordsets(strSql, dbOpenDynaset)
rsSql.MoveFirst
' prepare customer desc
sC = UCase(Trim(rsCust("fldDesc ription")) )
cArr = Split(sC, " ")
tempC = " " & sC & " "
' prepare grainger desc
sG = UCase(Trim(rsSql("RICHTEXT ")))
cArrg = Split(sG, " ")
' prepare grainger brand
sB = UCase(Trim(rsSql("WWGMFRNA ME")))
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").Va lue
!fldMfgname = rsCust.Fields("fldMfgname" ).Value
!fldMfgname = rsCust.Fields("fldMfgnameO rig").Valu e
!fldMfrnumST = rsCust.Fields("fldMfrnum") .Value
!fldMfrnumOrigST = rsCust.Fields("fldMfrnumOr ig").Value
!fldDescription = rsCust.Fields("fldDescript ion").Valu e
!fldDescriptionOrig = rsCust.Fields("fldDescript ionOrig"). Value
.Update
End With
'score = 0: wdFound = ""
rsSql.MoveNext
Loop
'append records to tblDataAppend
DoCmd.OpenQuery "ApdBruteQueryToDescMatchT able"
'''======================= ========== ======
'getScoreDescMatch nf1
End If
End If
rsCust.MoveNext
Loop
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("qryBr
Set dbs = CurrentDb
'=========================
' DECLARE RECORDSET
Set rsCust = CurrentDb.OpenRecordset("t
Set rsNoun = CurrentDb.OpenRecordset("t
Set rsCore = CurrentDb.OpenRecordset("t
' 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 "UpdTrimDescriptionBeforeD
Do Until rsCust.EOF
i = 0
If rsCust("fldDescription").V
' 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("qryBr
' sql
strSql = "SELECT TOP 3 tblNounMod1.ITEM, tblNounMod1.NOUNPHRS1, tblNounMod1.NOUNPHRS2, tblNounMod1.NOUNPHRS3, tblCoreSkuInformationST.RI
strSql = strSql & "tblCoreSkuInformationST.W
strSql = strSql & "tblCoreSkuInformationST.R
strSql = strSql & "tblCoreSkuInformationST.U
strSql = strSql & "tblCoreSkuInformationST.f
strSql = strSql & "FROM (tblNounMod1 INNER JOIN tblCoreSkuInformationST ON tblNounMod1.ITEM = tblCoreSkuInformationST.IT
strSql = strSql & "WHERE (((tblNounMod1.NOUNPHRS1) In (" & nf1 & "))) ORDER BY tblCoreSkuInformationST.fl
qd.sql = strSql
Set rsSql = dbs.Recordsets(strSql, dbOpenDynaset)
rsSql.MoveFirst
' prepare customer desc
sC = UCase(Trim(rsCust("fldDesc
cArr = Split(sC, " ")
tempC = " " & sC & " "
' prepare grainger desc
sG = UCase(Trim(rsSql("RICHTEXT
cArrg = Split(sG, " ")
' prepare grainger brand
sB = UCase(Trim(rsSql("WWGMFRNA
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").Va
!fldMfgname = rsCust.Fields("fldMfgname"
!fldMfgname = rsCust.Fields("fldMfgnameO
!fldMfrnumST = rsCust.Fields("fldMfrnum")
!fldMfrnumOrigST = rsCust.Fields("fldMfrnumOr
!fldDescription = rsCust.Fields("fldDescript
!fldDescriptionOrig = rsCust.Fields("fldDescript
.Update
End With
'score = 0: wdFound = ""
rsSql.MoveNext
Loop
'append records to tblDataAppend
DoCmd.OpenQuery "ApdBruteQueryToDescMatchT
'''=======================
'getScoreDescMatch nf1
End If
End If
rsCust.MoveNext
Loop
ASKER
cap,
did not have primary key on one of the query tables... really weird..
did not have primary key on one of the query tables... really weird..
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
results yes, But again it was because one of the inner jointables did not have a primary key >
change
Set rsSql = dbs.Recordsets(strSql, dbOpenDynaset)
to
Set rsSql = dbs.OpenRecordset(strSql, dbOpenDynaset)