Database becomes read-only at random

[thehours]

Hello,
I have an mdb file that acts like a focal point, which links 7 mdb files, including 6 input files, and 1 output file. The focal mdb file has this code that pulls one row at a time from each of the 6 input files, and feeds the data into an excel model. The excel model then creates one row of output which is moved to the mdb output file by the code.
I have about 1 million records, the code works well before it stops at random with the following error message:
Run-time error ‘-2147217911(80040e09)’:
Cannot update. Database or object is read-only.
Does anyone know what is causing this? I’m new to VBA and this is a legacy problem.
Your help is greatly appreciated!
********************************************************

[COLOR=black][FONT=Verdana]Set rstUpdate = New ADODB.Recordset[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]With rstUpdate[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]    Set .ActiveConnection = CurrentProject.Connection[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]    .CursorType = adOpenKeyset[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]    .LockType = adLockOptimistic[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]    .Open "tbl_Supercalc_Output", Options:=admCmdTableDirect[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]          [/FONT][/COLOR]
[COLOR=black][FONT=Verdana]    EndTime = Now()[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]     With rstUpdate[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            .AddNew[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            .Fields("Loan_sid") = objActiveWksh.Cells(7, 67).Value[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            .Fields("Interval") = EndTime[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            .Fields("Effective_Yield") = objActiveWksh.Cells(7, 68).Value[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            .Fields("All_in_Funding_Cost") = objActiveWksh.Cells(7, 69).Value[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            .Fields("Gross_Spread") = objActiveWksh.Cells(7, 70).Value[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            .Fields("Cost_to_Originate") = objActiveWksh.Cells(7, 71).Value[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            .Fields("Cost_to_Service") = objActiveWksh.Cells(7, 72).Value[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            …[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            .Update[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            End With[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]           Set rstUpdate = Nothing[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      .MoveNext[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]    Loop[/FONT][/COLOR]

 

[CJ_London]

you have a loop but it is not all there which implies you have not provided all the code - otherwise it would have failed on compile - so possibly the problem is there

 

[thehours]

The whole code is as below, thanks!

Option Compare Database
 
Sub RunSupercalc()
 
Dim Path As String, WorkbookName As String, WorksheetName As String, strWorkbookName As String
 
Path = CurrentProject.Path
 
strWorkbookName = Path & "\SUPERCALC Actual.xlsm"
 
 
Dim objActiveWkbk As Object
Dim objActiveWksh As Object
Dim objXL As Object
 
Dim Interval As Date
 
Set ObjExcel = CreateObject("Excel.Application")
ObjExcel.Application.Visible = True
 
Set objActiveWkbk = ObjExcel.Workbooks.Open(strWorkbookName)
Set objActiveWksh = objActiveWkbk.sheets("Data")
Set objInputs = objActiveWkbk.sheets("Inputs")

 
Set rst = New ADODB.Recordset
With rst
 
    Set .ActiveConnection = CurrentProject.Connection
    .CursorType = adOpenKeyset
   .Open "Supercalc_Inputs", Options:=admCmdTableDirect
 
   .MoveFirst
 
Do Until .EOF
 
objActiveWksh.Cells(4, 2) = rst.Fields("Loan_Sid")
 
 
' Getting all the supercalc_inputs and pasting into row 7
Dim lBalance_LoanSid As Double
lBalance_LoanSid = rst.Fields("Loan_Sid")
 
Set rstData = New ADODB.Recordset
With rstData
  Set .ActiveConnection = CurrentProject.Connection
   .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Open "SELECT Supercalc_Inputs.* FROM Supercalc_Inputs WHERE Supercalc_Inputs.LOAN_SID = " & lBalance_LoanSid & ";", Options:=admCmdTableDirect
  End With
objActiveWksh.Cells(7, 1).CopyFromRecordset rstData
 
rstData.Close
Set rstData = Nothing
 
'************************************************************************************
' Add record to Staging_Input_Loan_Sid
 
Set rstStaging = New ADODB.Recordset
 
With rstStaging
   Set .ActiveConnection = CurrentProject.Connection
    .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Open "Staging_Input_Loan_Sid", Options:=admCmdTableDirect
End With
 
With rstStaging
      .Fields("Loan_Sid") = objActiveWksh.Cells(7, 5).Value
      .Update
End With
 
rstStaging.Close
Set rstStaging = Nothing
 
'***************************************************************************************
'    DoCmd.SetWarnings False
 
'    DoCmd.SetWarnings True
 
 
'Add the Actual inputs from query with Loan sid from Staging_Input_Loan_Sid
Set rstInputs = New ADODB.Recordset
 
With rstInputs
  Set .ActiveConnection = CurrentProject.Connection
   .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Open " All_Actual_Input", Options:=admCmdTableDirect
End With
 
objInputs.Cells(7, 2).CopyFromRecordset rstInputs
 
rstInputs.Close
Set rstInputs = Nothing
 
 
'************************************************************************************************
Set rstUpdate = New ADODB.Recordset
With rstUpdate
    Set .ActiveConnection = CurrentProject.Connection
    .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Open "tbl_Supercalc_Output", Options:=admCmdTableDirect
End With
 
    EndTime = Now()
     With rstUpdate
            .AddNew
 
            .Fields("Loan_sid") = objActiveWksh.Cells(7, 67).Value
            .Fields("Interval") = EndTime
            .Fields("Effective_Yield") = objActiveWksh.Cells(7, 68).Value
            .Fields("All_in_Funding_Cost") = objActiveWksh.Cells(7, 69).Value
            .Fields("Gross_Spread") = objActiveWksh.Cells(7, 70).Value
            .Fields("Cost_to_Originate") = objActiveWksh.Cells(7, 71).Value
            .Fields("Cost_to_Service") = objActiveWksh.Cells(7, 72).Value

 ...
            
 
            .Update
            End With
           Set rstUpdate = Nothing
      .MoveNext
    Loop
 
    .Close
    End With
    Set rst = Nothing
 
    Set objstatus = ObjExcel.Workbooks.Open(statusworkbook)
    Set Statussheet = objstatus.sheets("Status")
    Statussheet.Cells(2, 2) = "Complete"
    Statussheet.Cells(2, 3) = Now()
    Statussheet.Cells(2, 4) = Mon2
 
 
    DoCmd.Hourglass False
 
End Sub

 

[CJ_London]

so to clarify - is the ... where the error occurs? and does it always occur at that point?

if so, I would check your data in the Supercalc_Inputs table - I suspect you have some null values or wrong datatypes

Alternatively, add some error control code to debug.print the values in objActiveWksh.Cells(7... to check they are valid

 

[thehours]

Thanks for your advice.

The error always occurs at the same point, when the program tries to add new entry to the 'tbl_supercalc_output' file.

Set rstUpdate = New ADODB.Recordset
With rstUpdate
    Set .ActiveConnection = CurrentProject.Connection
    .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Open "tbl_Supercalc_Output", Options:=admCmdTableDirect
End With
 
    EndTime = Now()
     With rstUpdate
            [COLOR="Red"][B].AddNew[/B][/COLOR]

I ran this procedure on two different computers, and one would give me the error message around every 30 minutes, the other would run for at least 7,8 hours before it stops. The difference being one is the working laptop I use daily, the other is a stand alone PC just for this procedure...

 

[Minty]

I seem to remember reading somewhere that recordset objects can generate quite big temporary files.
I haven't fully read the code but it appears that you are reopening the output table every time you add a record? As this is getting bigger all the time could it be that when it reaches a certain size the local machine runs out of memory to store the temporary recordset, before being able to add the new record?

Could you write a ID output to a separate table (single record) see how many records it has processed before it fails? Run it both machines if they fail at the same point it looks like a data error. If each machine fails on the a different record but repeatedly at the same point it would indicate a possible memory issue.

 

[DavidRBoyle]

It's possible that you are running out of disk-space or hitting the maximum size of a table or the whole database.

 

[thehours]

Memory issue is what I'm guessing!

I believe there's no data (type) error, since every time the program failed, if I closed the files and resumed the procedure from the last record, it worked alright and continued to add additional entries to the mdb output file.

For the stand alone computer, usually it can proccess about 70k up to 300k records in a roll.

How can I modify the code to reduce memory usage?

 

[spikepl]

get yourself the free Smart Indenter and indent your code properly - that makes it so much easier to read.

Whenever you have an .AddNew that means you do not need what is previously stored in the table, so instead of opening the table you need to open a query

SELECT * FROM MyTable WHERE 1=0


so that the recordset is empty (instead of having loaded the entire table)