Can´t update fields

Lojita

New member
Local time
Today, 12:50
Joined
Jun 25, 2013
Messages
8
After printing the report the user is asked if it was OK and then starts a procedure. The problem is that it returns an error message "3001".
The code is:
Private Sub Report_Close()
On Error GoTo Err_Report_Close
Dim db_contratos As Database
Dim rst As Recordset
Dim rst2 As Recordset
Dim sql As String
Dim num_rec As Long
Dim count As Long
Dim varReturn As Variant
Dim datahoje As Date
datahoje = Date
MsgBox datahoje, vbInformation

If MsgBox("As Fichas de Aptidão foram bem impressas?", vbYesNo, " ") = vbYes Then
DoCmd.Hourglass True
sql = "SELECT CONTRATOS.* FROM CONTRATOS "
If Forms!Abertura!Criterio <> "" Then
sql = sql + "WHERE "
sql = sql + Forms!Abertura!Criterio
End If
sql = sql + " ORDER BY CONTRATOS.[Nº Contrato];"

Set db_contratos = DBEngine.Workspaces(0).Databases(0)
Set rst = db_contratos.OpenRecordset("Q_FICHA_APTIDAO", dbOpenDynamic)
Set rst2 = db_contratos.OpenRecordset(sql)
rst.MoveLast
num_rec = rst.RecordCount
rst.MoveFirst
varReturn = SysCmd(acSysCmdInitMeter, "Updating Contratos Renovados", num_rec)
count = 0

Do While ((Not rst2.EOF) And (count <= num_rec))
Do While (Not rst.EOF)
If rst2("Nº Contrato") = rst("CONTRATOS.Nº Contrato") Then
rst.Edit
rst(TRABALHADORES.FichaAptidao) = True
rst(TRABALHADORES.datafaptidao) = Me.UltConsulta.Value
rst.Update
varReturn = SysCmd(acSysCmdUpdateMeter, count)
count = count + 1
End If
rst.MoveNext
Loop
rst.MoveFirst
rst2.MoveNext
Loop

rst.Close
rst2.Close
db_contratos.Close
varReturn = SysCmd(acSysCmdRemoveMeter)
DoCmd.Hourglass False
End If
Exit_Report_Close:
Exit Sub

Err_Report_Close:
MsgBox Err.Source & Err.HelpContext, vbCritical, "Erro a actualizar Fichas de Aptidão"
varReturn = SysCmd(acSysCmdRemoveMeter)
DoCmd.Hourglass False
Resume Exit_Report_Close
End Sub

What is missing?
Thanks in advance
 
On what line do you get the error?
What version of Access?
What are you wanting to do?

Dale
 
My apologies.
The error appears when updating fields (code bellow):

Do While ((Not rst2.EOF) And (count <= num_rec))
Do While (Not rst.EOF)
If rst2("Nº Contrato") = rst("CONTRATOS.Nº Contrato") Then
rst.Edit
rst(TRABALHADORES.FichaAptidao) = True
rst(TRABALHADORES.datafaptidao) = Me.UltConsulta.Value
rst.Update
varReturn = SysCmd(acSysCmdUpdateMeter, count)
count = count + 1
End If
rst.MoveNext
Loop
rst.MoveFirst
rst2.MoveNext
Loop

I have the 2010 Access and this is for updating a checkbox and a date field in the TRABALHADORES table after printing a report.
This procedure runs a query (Q_FICHA_APTIDAO) to determine who's going to be updated.

Thanks
 
1) Do you know what error 3002 represent ?
I wish to say that "error 3001" is NOT a information for me (I don't wish to say "for us")
2) Where the code is stopped ? I see 1001 lines of code.
3) Have you compile the code before run it ?
I have huge doubts that the compiler do not stop.

Before you will write a new post, disable line 2 (On Error GoTo Err_Report_Close).
Run the code and you will see exactly where you have problems.

Cheers !
 
Code:
Do While ((Not rst2.EOF) And (count <= num_rec))
Do While (Not rst.EOF)
If rst2[B][COLOR=DarkRed]![[/COLOR][/B]Nº Contrato[COLOR=DarkRed]][/COLOR] = rst[COLOR=DarkRed][B]![[/B][/COLOR]CONTRATOS[B][COLOR=DarkRed]][/COLOR][/B].[B][COLOR=DarkRed][[/COLOR][/B]Nº Contrato[COLOR=DarkRed][B]][/B][/COLOR] Then
rst.Edit
rst[COLOR=DarkRed][B]![[/B][/COLOR]TRABALHADORES[U][COLOR=DarkRed]][/COLOR][/U].[COLOR=DarkRed][B][[/B][/COLOR]FichaAptidao[B][COLOR=DarkRed]][/COLOR][/B] = True
rst[COLOR=DarkRed][B]![[/B][/COLOR]TRABALHADORES[B][COLOR=DarkRed]][/COLOR][/B].[COLOR=DarkRed][B][[/B][/COLOR]datafaptidao[B][COLOR=DarkRed]][/COLOR][/B] = Me.UltConsulta.Value
rst.Update
[COLOR=DarkRed][B]rst.Bookmark = .LastModified[/B][/COLOR]
varReturn = SysCmd(acSysCmdUpdateMeter, count)
count = count + 1
End If
rst.MoveNext
Loop
rst.MoveFirst
rst2.MoveNext
Loop
[COLOR=DarkRed][B]rst.close
rst2.close[/B][/COLOR]
[COLOR=DarkRed][B]db_contratos.close
Set rst = nothing
Set rst2 = Nothing
[/B][/COLOR]

Can you tell us which line the code errors on?

Dale
 
I saw a few errors at the top of your code.

Dim db_contratos As Database
Dim rst As DAO.Recordset
Dim rst2 As DAORecordset
Dim sql As String
Dim num_rec As Long
Dim count As Long
Dim varReturn As Variant
Dim datahoje As Date

Set db_contratos = DBEngine.Workspaces(0).Databases(0)
Set db_contratos = currentDB

Dale
 
Hello again.
After reading your posts I tried to modify my code and the error comes in this line:
rst.Edit (error 3027 - Database or object read only)

Ideas please! :banghead:

Thanks
 
So, the problem seems to be in this line:
Code:
Set rst = db_contratos.OpenRecordset("Q_FICHA_APTIDAO", dbOpenDynamic)
Is "Q_FICHA_APTIDAO" a query ?
Is this query updatable ? You can verify that by opening the query and trying to manually make changes.
 
Morning.
This report is based in this query Q_FICHA_APTIDAO and I've tried to open it manually and it's not updatable.
What can be done?
 
Sorry, but this question is beyond my skill.
Hope someone else have some advices from where we'll can learn.
 
Please post the SQL for the query.

Dale
 
Hello Dale.
Here goes the SQL code for the query:

SELECT CONTRATOS.*, TRABALHADORES.*, DELEGACAO.*, TRABALHADORES.FichaAptidao, TRABALHADORES.Consulta
FROM (CONTRATOS INNER JOIN TRABALHADORES ON CONTRATOS.[Nº Contrato] = TRABALHADORES.[Nº Contrato]) INNER JOIN DELEGACAO ON (TRABALHADORES.[delegacao] = DELEGACAO.cod_delegacao) AND (CONTRATOS.[Nº Contrato] = DELEGACAO.contrato)
WHERE (((TRABALHADORES.FichaAptidao)=False) AND ((TRABALHADORES.Consulta)=True) AND ((CONTRATOS.Anulado)=False));

Thanks
 
The problem lies here, [FONT=&quot]SELECT CONTRATOS.*, TRABALHADORES.*, DELEGACAO.*
Multi-tables in a query are seldom updateable.

Also looks like your tables are not normalized .

Dale
[/FONT]
 
Thanks all for the help, but what can I do?
I do need some info of this three tables and need to update some fields in TRABALHADORES. :confused:
 
Then update the fields in TRABALHADORES, not in the query.
 

Users who are viewing this thread

Back
Top Bottom