Locked Database Problem

  • Thread starter Thread starter JM
  • Start date Start date
J

JM

I loaded some windows updates to my PC today, which included a Jet 4 patch.
Since then I've had a problem. If I run some code, then the database becomes
locked, even to me.

In other words suppose I edit my code. Before testing the changes, I can
save the module. After running I cannot, the db is locked. I am warned that
"You do not have exclusive access to the database at this time. Your changes
will not be saved". However it is only opened by me.

More importantly I can't see any db objects that I've left open. It seems to
be the With Currentdb that "opens" the db, but that's a bog standard line.
The following code is the one I'm trying to edit.

I am running Access 200 Win XP Home and references Jet DAO 3.6






Sub test_SetChurn()
Dim sDB As String, db As DAO.Database
'Get path for Results db
sDB = GetSetting(scAppTitle, "Parameters", "AccessDB01", "")
If sDB = "" Then MsgBox "Error, no Data db located", vbCritical, "Error":
Exit Sub
Set db = OpenDatabase(sDB)
fnSetChurnLife 4, db
db.Close

Set db = Nothing
End Sub

Public Function fnSetChurnLife(iOption As Integer, db As DAO.Database) As
Boolean
'Purpose: This prodecure sets the Life column in a table dealing with
Churn
'Parameters: dAvgChurn - This is the calculated churn taken from the
given period figures
' dExpectedChurn - This is the predicted churn. It is stored
in tbParameters. The above figure in theory should match this
' dMaximumLife - This is the maximum life. It is stored in
tbParameters. The parameter is design to prevent excessive Life predictions
'--------------------------------------------------------------------
Dim dAvgChurn(1) As Double, dExpectedChurn(1) As Double, dMaximumLife(1)
As Double, sCurrentPeriod As String
Dim sSQL As String, sSQL_Insert As String, sSQL_Select As String,
sSQL_From As String
Dim sTable As String, i As Integer 'arrSQL As Variant
Const sChurnLifeTable As String = "dtChurnRate"
Dim rst As DAO.Recordset

sTable = "dtDimTable"

On Error GoTo errFunction
With CurrentDb
'1. Get current period
sCurrentPeriod = GetSetting(scAppTitle, "Parameters", "CurrentPeriod",
"2003-01")

'2. Get calculated churn figures.
' Calculated Churn is the actual value from the period's figures
sSQL = "SELECT IIf([CustomerTypeOros]='Prepaid','Prepaid','Postpaid') AS
Type, " _
& "Sum(tbDataChurn.Subscribers) AS Subscribers, " _
& "Sum(IIf([tbDataChurn].[IsChurn],[tbDataChurn].[Subscribers],0)) AS
SubIsChurn " _
& "FROM tbDataChurn LEFT JOIN tbLookupCustomerType ON
tbDataChurn.CustomerType = tbLookupCustomerType.CustomerTypeSource " _
& "WHERE (((tbDataChurn.Period) = '" & sCurrentPeriod & "')) " _
& "GROUP BY IIf([CustomerTypeOros]='Prepaid','Prepaid','Postpaid') " _
& "ORDER BY IIf([CustomerTypeOros]='Prepaid','Prepaid','Postpaid');"
Set rst = .OpenRecordset(sSQL, dbOpenForwardOnly)
'2.1 Postpaid
dAvgChurn(notPPD) = rst(2) / rst(1)
'2.2 Prepaid
rst.MoveNext
dAvgChurn(PPD) = rst(2) / rst(1)
rst.Close

'code snipped out here because to isolate this problem I commented it all
out but it still generates the error.

fnSetChurnLife = True
exitFunction:
Set rst = Nothing
' CurrentDb.Close
Exit Function
errFunction:
Select Case Err
Case Else
MsgBox Err.Description & " (" & Err & ")", vbCritical, "Error"
End Select
End With
fnSetChurnLife = False
Resume exitFunction
End Function
 
Subsequently I commented out ALL the code in the fnSetChurnLife function
between With Currentdb and exitFunction and it still generates the error,
even after a reboot.
 
JM said:
I loaded some windows updates to my PC today, which included a Jet 4
patch. Since then I've had a problem. If I run some code, then the
database becomes locked, even to me.

In other words suppose I edit my code. Before testing the changes, I
can save the module. After running I cannot, the db is locked. I am
warned that "You do not have exclusive access to the database at this
time. Your changes will not be saved". However it is only opened by
me.

More importantly I can't see any db objects that I've left open. It
seems to be the With Currentdb that "opens" the db, but that's a bog
standard line. The following code is the one I'm trying to edit.

I am running Access 200 Win XP Home and references Jet DAO 3.6






Sub test_SetChurn()
Dim sDB As String, db As DAO.Database
'Get path for Results db
sDB = GetSetting(scAppTitle, "Parameters", "AccessDB01", "")
If sDB = "" Then MsgBox "Error, no Data db located", vbCritical,
"Error": Exit Sub
Set db = OpenDatabase(sDB)
fnSetChurnLife 4, db
db.Close

Set db = Nothing
End Sub

Public Function fnSetChurnLife(iOption As Integer, db As
DAO.Database) As Boolean
'Purpose: This prodecure sets the Life column in a table
dealing with Churn
'Parameters: dAvgChurn - This is the calculated churn taken
from the given period figures
' dExpectedChurn - This is the predicted churn. It is
stored in tbParameters. The above figure in theory should match this
' dMaximumLife - This is the maximum life. It is
stored in tbParameters. The parameter is design to prevent excessive
Life predictions

'--------------------------------------------------------------------
Dim dAvgChurn(1) As Double, dExpectedChurn(1) As Double,
dMaximumLife(1)
As Double, sCurrentPeriod As String
Dim sSQL As String, sSQL_Insert As String, sSQL_Select As String,
sSQL_From As String
Dim sTable As String, i As Integer 'arrSQL As Variant
Const sChurnLifeTable As String = "dtChurnRate"
Dim rst As DAO.Recordset

sTable = "dtDimTable"

On Error GoTo errFunction
With CurrentDb
'1. Get current period
sCurrentPeriod = GetSetting(scAppTitle, "Parameters",
"CurrentPeriod", "2003-01")

'2. Get calculated churn figures.
' Calculated Churn is the actual value from the period's figures
sSQL = "SELECT
IIf([CustomerTypeOros]='Prepaid','Prepaid','Postpaid') AS Type, " _
& "Sum(tbDataChurn.Subscribers) AS Subscribers, " _
&
"Sum(IIf([tbDataChurn].[IsChurn],[tbDataChurn].[Subscribers],0)) AS
SubIsChurn " _ & "FROM tbDataChurn LEFT JOIN
tbLookupCustomerType ON tbDataChurn.CustomerType =
tbLookupCustomerType.CustomerTypeSource " _ & "WHERE
(((tbDataChurn.Period) = '" & sCurrentPeriod & "')) " _ &
"GROUP BY
IIf([CustomerTypeOros]='Prepaid','Prepaid','Postpaid') " _ &
"ORDER BY
IIf([CustomerTypeOros]='Prepaid','Prepaid','Postpaid');" Set rst
= .OpenRecordset(sSQL, dbOpenForwardOnly) '2.1 Postpaid
dAvgChurn(notPPD) = rst(2) / rst(1) '2.2 Prepaid rst.MoveNext
dAvgChurn(PPD) = rst(2) / rst(1)
rst.Close

'code snipped out here because to isolate this problem I commented it
all out but it still generates the error.

fnSetChurnLife = True
exitFunction:
Set rst = Nothing
' CurrentDb.Close
Exit Function
errFunction:
Select Case Err
Case Else
MsgBox Err.Description & " (" & Err & ")", vbCritical, "Error"
End Select
End With
fnSetChurnLife = False
Resume exitFunction
End Function
Click to expand...

I'm not sure if it's relevant or not, but in your code is the database
object being opened in this line:
Set db = OpenDatabase(sDB)
Click to expand...

the same physical database as the database in which the code is running?
If so, it seems to me that would be a second connection to the database,
which might be perhaps be cached by Access; then Access would consider
that your primary connection doesn't have exclusive access to the
database since there are two connections to it. This is highly
speculative, of course.

I don't see that you are doing anything with db, by the way, as that
argument to fnSetChurnLife() doesn't appear to be referenced; however,
that reference may have been in the code you snipped out.
 
Dirk Goldgar said:
JM said:
I loaded some windows updates to my PC today, which included a Jet 4
patch. Since then I've had a problem. If I run some code, then the
database becomes locked, even to me.

In other words suppose I edit my code. Before testing the changes, I
can save the module. After running I cannot, the db is locked. I am
warned that "You do not have exclusive access to the database at this
time. Your changes will not be saved". However it is only opened by
me.

More importantly I can't see any db objects that I've left open. It
seems to be the With Currentdb that "opens" the db, but that's a bog
standard line. The following code is the one I'm trying to edit.

I am running Access 200 Win XP Home and references Jet DAO 3.6






Sub test_SetChurn()
Dim sDB As String, db As DAO.Database
'Get path for Results db
sDB = GetSetting(scAppTitle, "Parameters", "AccessDB01", "")
If sDB = "" Then MsgBox "Error, no Data db located", vbCritical,
"Error": Exit Sub
Set db = OpenDatabase(sDB)
fnSetChurnLife 4, db
db.Close

Set db = Nothing
End Sub

Public Function fnSetChurnLife(iOption As Integer, db As
DAO.Database) As Boolean
'Purpose: This prodecure sets the Life column in a table
dealing with Churn
'Parameters: dAvgChurn - This is the calculated churn taken
from the given period figures
' dExpectedChurn - This is the predicted churn. It is
stored in tbParameters. The above figure in theory should match this
' dMaximumLife - This is the maximum life. It is
stored in tbParameters. The parameter is design to prevent excessive
Life predictions

'--------------------------------------------------------------------
Dim dAvgChurn(1) As Double, dExpectedChurn(1) As Double,
dMaximumLife(1)
As Double, sCurrentPeriod As String
Dim sSQL As String, sSQL_Insert As String, sSQL_Select As String,
sSQL_From As String
Dim sTable As String, i As Integer 'arrSQL As Variant
Const sChurnLifeTable As String = "dtChurnRate"
Dim rst As DAO.Recordset

sTable = "dtDimTable"

On Error GoTo errFunction
With CurrentDb
'1. Get current period
sCurrentPeriod = GetSetting(scAppTitle, "Parameters",
"CurrentPeriod", "2003-01")

'2. Get calculated churn figures.
' Calculated Churn is the actual value from the period's figures
sSQL = "SELECT
IIf([CustomerTypeOros]='Prepaid','Prepaid','Postpaid') AS Type, " _
& "Sum(tbDataChurn.Subscribers) AS Subscribers, " _
&
"Sum(IIf([tbDataChurn].[IsChurn],[tbDataChurn].[Subscribers],0)) AS
SubIsChurn " _ & "FROM tbDataChurn LEFT JOIN
tbLookupCustomerType ON tbDataChurn.CustomerType =
tbLookupCustomerType.CustomerTypeSource " _ & "WHERE
(((tbDataChurn.Period) = '" & sCurrentPeriod & "')) " _ &
"GROUP BY
IIf([CustomerTypeOros]='Prepaid','Prepaid','Postpaid') " _ &
"ORDER BY
IIf([CustomerTypeOros]='Prepaid','Prepaid','Postpaid');" Set rst
= .OpenRecordset(sSQL, dbOpenForwardOnly) '2.1 Postpaid
dAvgChurn(notPPD) = rst(2) / rst(1) '2.2 Prepaid rst.MoveNext
dAvgChurn(PPD) = rst(2) / rst(1)
rst.Close

'code snipped out here because to isolate this problem I commented it
all out but it still generates the error.

fnSetChurnLife = True
exitFunction:
Set rst = Nothing
' CurrentDb.Close
Exit Function
errFunction:
Select Case Err
Case Else
MsgBox Err.Description & " (" & Err & ")", vbCritical, "Error"
End Select
End With
fnSetChurnLife = False
Resume exitFunction
End Function
Click to expand...

I'm not sure if it's relevant or not, but in your code is the database
object being opened in this line:
Set db = OpenDatabase(sDB)
Click to expand...

the same physical database as the database in which the code is running?
If so, it seems to me that would be a second connection to the database,
which might be perhaps be cached by Access; then Access would consider
that your primary connection doesn't have exclusive access to the
database since there are two connections to it. This is highly
speculative, of course.
Click to expand...

It is a different database to the current db. The app is separated into
front end and back end. In the back end db I create (or clear) a table and
populate it with data. The other stuff is about setting defaults so that I
can have a value like IIf(<cond>, default1, default2).

In any case commenting out everything except With Current..to ..End Current
still generated the error.

After my last contrib to this thread I had a coffee and rebooted and the
fault was gone. I therefore suspect that the db had become corrupted at some
point. Rolling back XP involved a reboot, but this didn't clear the problem,
but importing all the objects into a fresh db solved everything (albeit
after I calmed down and rebooted).

Thank you for helping.
 
Back
Top