Runtime error 3014 - Can't open more tables


G

Guest

Hey all,

I am receiving this error when i'm trying to run a routine that I didn't
create. I know this should be a sp on my sql box but I haven't got the
resource to do it right now.

Basically I know that access is struggling not creating tables, but table
references, I have tried all the ms knowledge base and newsgroups and I don't
seem to be able to find any adequate reference material to try solve this. I
have been through the code trying to make sure that all my recordsets and
querydef objects are being explicitly closed, yet I cannot seem to past 1103
records of the 3000 I need to process. It stops consistently at the same
point. I am using jet4.0 vanilla that comes with xp sp2;

here is my entire forms code, yes, there is DAO in there, im in the process
of re-writing the whole system;

Code:
Option Compare Database
Option Explicit

Dim lUpdateID As Long

Private Sub CloseButton_Click()
DoCmd.Close
End Sub

Private Sub OKButton_Click()
Dim rst As DAO.Recordset
Dim rstP As DAO.Recordset
Dim strSQL As String
Dim strAssembly As String
Dim strComponent As String
Dim sngQty As Single
Dim SubAssemblyCost As Single
Dim I As Integer
Dim iRecords As Long
Dim dblPerCent As Double

Dim strNowTime As String
Dim dtStartTime As Date
Dim Elapsed As String
Dim EstFinish As String

DoCmd.Hourglass True
'  lUpdateID = 111

strSQL = "SELECT [Product Code] FROM Product " & _
"WHERE Assembly = True"
Set rstP = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
rstP.MoveLast
iRecords = rstP.RecordCount
rstP.MoveFirst

dtStartTime = Time
strNowTime = CStr(Time)
EstFinish = CStr(dtStartTime + 30)

Me!StartLabel.Caption = strNowTime

For I = 1 To iRecords
strAssembly = rstP![Product Code]
Me!ProdLabel.Caption = strAssembly
Me!RecordLabel.Caption = I & " of " & iRecords
dblPerCent = CDbl(I * (100 / iRecords))
Me!PercentLabel.Caption = Format(dblPerCent, "##") & "%"
Me.Repaint
If I Mod 10 = 0 Then
DoEvents
End If
strSQL = "SELECT * FROM BOMData " & _
"WHERE Parent = """ & strAssembly & """"
Set rst = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
If rst.EOF = True Then
rst.Close
Else
SubAssemblyCost = 0
Do While rst.EOF = False
sngQty = GetSubCost(rst!Component)
If sngQty = 999999 Then
sngQty = GetProductCost(rst!Component)
If rst!Assembly = True Then
rst.Edit
rst!Assembly = False
rst.Update
End If
Else
UpdateProductCost rst!Component, sngQty
If rst!Assembly = False Then
rst.Edit
rst!Assembly = True
rst.Update
End If
End If
SubAssemblyCost = SubAssemblyCost + sngQty * rst!Qty
rst.MoveNext
Loop
rst.Close
UpdateProductCost strAssembly, SubAssemblyCost
End If

rstP.MoveNext
Elapsed = Time - dtStartTime
EstFinish = iRecords * Elapsed / I
Me!FinishLabel.Caption = CStr(EstFinish + dtStartTime)
Next I
rstP.Close
DoCmd.Hourglass False
MsgBox "Finished at " & Time
DoCmd.Close
End Sub

Function GetSubCost(strCode)
Dim rst As DAO.Recordset
Dim strSQL As String
Dim sngQty As Single
Dim SubAssemblyCost As Single

'  strSQL = "SELECT * FROM BOMData " & _
"WHERE Parent = """ & strCode & """"
strSQL = "SELECT Product.[Product Code], BOMData.Component, BOMData.Qty, "
& _
"BOMData.Assembly " & _
"FROM Product INNER JOIN BOMData ON Product.[Product Code] =
BOMData.Parent " & _
"WHERE (((Product.[Product Code])=""" & strCode & """) AND
((Product.SparesOnly)=False));"
Set rst = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
If rst.EOF = True Then
rst.Close
GetSubCost = 999999
Exit Function
End If
SubAssemblyCost = 0
Do While rst.EOF = False
sngQty = GetSubCost(rst!Component)
If sngQty = 999999 Then
sngQty = GetProductCost(rst!Component)
If rst!Assembly = True Then
rst.Edit
rst!Assembly = False
rst.Update
End If
Else
UpdateProductCost rst!Component, sngQty
If rst!Assembly = False Then
rst.Edit
rst!Assembly = True
rst.Update
End If
End If
SubAssemblyCost = SubAssemblyCost + sngQty * rst!Qty
rst.MoveNext
Loop

rst.Close
GetSubCost = SubAssemblyCost
End Function

Function GetProductCost(strCode)
Dim rstP As DAO.Recordset
Dim strSQL As String

strSQL = "SELECT Cost FROM Product " & _
"WHERE [Product Code] = """ & strCode & """"
Set rstP = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
If rstP.EOF = False Then GetProductCost = Nz(rstP!Cost)
rstP.Close
End Function

Function UpdateProductCost(strCode As String, cCost As Single)
Dim strSQL As String
Dim qdfChange As QueryDef

strSQL = "UPDATE Product SET Cost = " & cCost & _
" WHERE [SparesOnly] = False AND [Product Code] = """ & strCode & """"

Set qdfChange = CurrentDb.CreateQueryDef("", strSQL)
qdfChange.Execute
'barry - closing objects
qdfChange.Close
Set qdfChange = Nothing

End Function

The routine will loop 1103 times before providing me with the error.

Thanks for your time.
Pace
 
Ad

Advertisements

P

pietlinden

Hey all,

I am receiving this error when i'm trying to run a routine that I didn't
create. I know this should be a sp on my sql box but I haven't got the
resource to do it right now.

Basically I know that access is struggling not creating tables, but table
references, I have tried all the ms knowledge base and newsgroups and I don't
seem to be able to find any adequate reference material to try solve this. I
have been through the code trying to make sure that all my recordsets and
querydef objects are being explicitly closed, yet I cannot seem to past 1103
records of the 3000 I need to process. It stops consistently at the same
point. I am using jet4.0 vanilla that comes with xp sp2;

here is my entire forms code, yes, there is DAO in there, im in the process
of re-writing the whole system;

Code:
Option Compare Database
Option Explicit

Dim lUpdateID As Long

Private Sub CloseButton_Click()
DoCmd.Close
End Sub

Private Sub OKButton_Click()
Dim rst As DAO.Recordset
Dim rstP As DAO.Recordset
Dim strSQL As String
Dim strAssembly As String
Dim strComponent As String
Dim sngQty As Single
Dim SubAssemblyCost As Single
Dim I As Integer
Dim iRecords As Long
Dim dblPerCent As Double

Dim strNowTime As String
Dim dtStartTime As Date
Dim Elapsed As String
Dim EstFinish As String

DoCmd.Hourglass True
'  lUpdateID = 111

strSQL = "SELECT [Product Code] FROM Product " & _
"WHERE Assembly = True"
Set rstP = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
rstP.MoveLast
iRecords = rstP.RecordCount
rstP.MoveFirst

dtStartTime = Time
strNowTime = CStr(Time)
EstFinish = CStr(dtStartTime + 30)

Me!StartLabel.Caption = strNowTime

For I = 1 To iRecords
strAssembly = rstP![Product Code]
Me!ProdLabel.Caption = strAssembly
Me!RecordLabel.Caption = I & " of " & iRecords
dblPerCent = CDbl(I * (100 / iRecords))
Me!PercentLabel.Caption = Format(dblPerCent, "##") & "%"
Me.Repaint
If I Mod 10 = 0 Then
DoEvents
End If
strSQL = "SELECT * FROM BOMData " & _
"WHERE Parent = """ & strAssembly & """"
Set rst = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
If rst.EOF = True Then
rst.Close
Else
SubAssemblyCost = 0
Do While rst.EOF = False
sngQty = GetSubCost(rst!Component)
If sngQty = 999999 Then
sngQty = GetProductCost(rst!Component)
If rst!Assembly = True Then
rst.Edit
rst!Assembly = False
rst.Update
End If
Else
UpdateProductCost rst!Component, sngQty
If rst!Assembly = False Then
rst.Edit
rst!Assembly = True
rst.Update
End If
End If
SubAssemblyCost = SubAssemblyCost + sngQty * rst!Qty
rst.MoveNext
Loop
rst.Close
UpdateProductCost strAssembly, SubAssemblyCost
End If

rstP.MoveNext
Elapsed = Time - dtStartTime
EstFinish = iRecords * Elapsed / I
Me!FinishLabel.Caption = CStr(EstFinish + dtStartTime)
Next I
rstP.Close
DoCmd.Hourglass False
MsgBox "Finished at " & Time
DoCmd.Close
End Sub

Function GetSubCost(strCode)
Dim rst As DAO.Recordset
Dim strSQL As String
Dim sngQty As Single
Dim SubAssemblyCost As Single

'  strSQL = "SELECT * FROM BOMData " & _
"WHERE Parent = """ & strCode & """"
strSQL = "SELECT Product.[Product Code], BOMData.Component, BOMData.Qty, "
& _
"BOMData.Assembly " & _
"FROM Product INNER JOIN BOMData ON Product.[Product Code] =
BOMData.Parent " & _
"WHERE (((Product.[Product Code])=""" & strCode & """) AND
((Product.SparesOnly)=False));"
Set rst = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
If rst.EOF = True Then
rst.Close
GetSubCost = 999999
Exit Function
End If
SubAssemblyCost = 0
Do While rst.EOF = False
sngQty = GetSubCost(rst!Component)
If sngQty = 999999 Then
sngQty = GetProductCost(rst!Component)
If rst!Assembly = True Then
rst.Edit
rst!Assembly = False
rst.Update
End If
Else
UpdateProductCost rst!Component, sngQty
If rst!Assembly = False Then
rst.Edit
rst!Assembly = True
rst.Update
End If
End If
SubAssemblyCost = SubAssemblyCost + sngQty * rst!Qty
rst.MoveNext
Loop

rst.Close
GetSubCost = SubAssemblyCost
End Function

Function GetProductCost(strCode)
Dim rstP As DAO.Recordset
Dim strSQL As String

strSQL = "SELECT Cost FROM Product " & _
"WHERE [Product Code] = """ & strCode & """"
Set rstP = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
If rstP.EOF = False Then GetProductCost = Nz(rstP!Cost)
rstP.Close
End Function

Function UpdateProductCost(strCode As String, cCost As Single)
Dim strSQL As String
Dim qdfChange As QueryDef

strSQL = "UPDATE Product SET Cost = " & cCost & _
" WHERE [SparesOnly] = False AND [Product Code] = """ & strCode & """"

Set qdfChange = CurrentDb.CreateQueryDef("", strSQL)
qdfChange.Execute
'barry - closing objects
qdfChange.Close
Set qdfChange = Nothing

End Function

The routine will loop 1103 times before providing me with the error.

Thanks for your time.
Pace

the code should close and destroy all references to the objects it
opens. So if you open an object, like a recordset, at the end of the
code, there should be a statement like

rst.CLOSE
set rst=Nothing

this removes the recordset from memory, and the connection to the
table.

Once you do that, your code should be fine.
 
G

Guest

Explicitly closing has no effect on this. Its so strange I cannot work it out.

Hey all,

I am receiving this error when i'm trying to run a routine that I didn't
create. I know this should be a sp on my sql box but I haven't got the
resource to do it right now.

Basically I know that access is struggling not creating tables, but table
references, I have tried all the ms knowledge base and newsgroups and I don't
seem to be able to find any adequate reference material to try solve this. I
have been through the code trying to make sure that all my recordsets and
querydef objects are being explicitly closed, yet I cannot seem to past 1103
records of the 3000 I need to process. It stops consistently at the same
point. I am using jet4.0 vanilla that comes with xp sp2;

here is my entire forms code, yes, there is DAO in there, im in the process
of re-writing the whole system;

Code:
Option Compare Database
Option Explicit

Dim lUpdateID As Long

Private Sub CloseButton_Click()
DoCmd.Close
End Sub

Private Sub OKButton_Click()
Dim rst As DAO.Recordset
Dim rstP As DAO.Recordset
Dim strSQL As String
Dim strAssembly As String
Dim strComponent As String
Dim sngQty As Single
Dim SubAssemblyCost As Single
Dim I As Integer
Dim iRecords As Long
Dim dblPerCent As Double

Dim strNowTime As String
Dim dtStartTime As Date
Dim Elapsed As String
Dim EstFinish As String

DoCmd.Hourglass True
'  lUpdateID = 111

strSQL = "SELECT [Product Code] FROM Product " & _
"WHERE Assembly = True"
Set rstP = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
rstP.MoveLast
iRecords = rstP.RecordCount
rstP.MoveFirst

dtStartTime = Time
strNowTime = CStr(Time)
EstFinish = CStr(dtStartTime + 30)

Me!StartLabel.Caption = strNowTime

For I = 1 To iRecords
strAssembly = rstP![Product Code]
Me!ProdLabel.Caption = strAssembly
Me!RecordLabel.Caption = I & " of " & iRecords
dblPerCent = CDbl(I * (100 / iRecords))
Me!PercentLabel.Caption = Format(dblPerCent, "##") & "%"
Me.Repaint
If I Mod 10 = 0 Then
DoEvents
End If
strSQL = "SELECT * FROM BOMData " & _
"WHERE Parent = """ & strAssembly & """"
Set rst = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
If rst.EOF = True Then
rst.Close
Else
SubAssemblyCost = 0
Do While rst.EOF = False
sngQty = GetSubCost(rst!Component)
If sngQty = 999999 Then
sngQty = GetProductCost(rst!Component)
If rst!Assembly = True Then
rst.Edit
rst!Assembly = False
rst.Update
End If
Else
UpdateProductCost rst!Component, sngQty
If rst!Assembly = False Then
rst.Edit
rst!Assembly = True
rst.Update
End If
End If
SubAssemblyCost = SubAssemblyCost + sngQty * rst!Qty
rst.MoveNext
Loop
rst.Close
UpdateProductCost strAssembly, SubAssemblyCost
End If

rstP.MoveNext
Elapsed = Time - dtStartTime
EstFinish = iRecords * Elapsed / I
Me!FinishLabel.Caption = CStr(EstFinish + dtStartTime)
Next I
rstP.Close
DoCmd.Hourglass False
MsgBox "Finished at " & Time
DoCmd.Close
End Sub

Function GetSubCost(strCode)
Dim rst As DAO.Recordset
Dim strSQL As String
Dim sngQty As Single
Dim SubAssemblyCost As Single

'  strSQL = "SELECT * FROM BOMData " & _
"WHERE Parent = """ & strCode & """"
strSQL = "SELECT Product.[Product Code], BOMData.Component, BOMData.Qty, "
& _
"BOMData.Assembly " & _
"FROM Product INNER JOIN BOMData ON Product.[Product Code] =
BOMData.Parent " & _
"WHERE (((Product.[Product Code])=""" & strCode & """) AND
((Product.SparesOnly)=False));"
Set rst = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
If rst.EOF = True Then
rst.Close
GetSubCost = 999999
Exit Function
End If
SubAssemblyCost = 0
Do While rst.EOF = False
sngQty = GetSubCost(rst!Component)
If sngQty = 999999 Then
sngQty = GetProductCost(rst!Component)
If rst!Assembly = True Then
rst.Edit
rst!Assembly = False
rst.Update
End If
Else
UpdateProductCost rst!Component, sngQty
If rst!Assembly = False Then
rst.Edit
rst!Assembly = True
rst.Update
End If
End If
SubAssemblyCost = SubAssemblyCost + sngQty * rst!Qty
rst.MoveNext
Loop

rst.Close
GetSubCost = SubAssemblyCost
End Function

Function GetProductCost(strCode)
Dim rstP As DAO.Recordset
Dim strSQL As String

strSQL = "SELECT Cost FROM Product " & _
"WHERE [Product Code] = """ & strCode & """"
Set rstP = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset, [dbSeeChanges])
If rstP.EOF = False Then GetProductCost = Nz(rstP!Cost)
rstP.Close
End Function

Function UpdateProductCost(strCode As String, cCost As Single)
Dim strSQL As String
Dim qdfChange As QueryDef

strSQL = "UPDATE Product SET Cost = " & cCost & _
" WHERE [SparesOnly] = False AND [Product Code] = """ & strCode & """"

Set qdfChange = CurrentDb.CreateQueryDef("", strSQL)
qdfChange.Execute
'barry - closing objects
qdfChange.Close
Set qdfChange = Nothing

End Function

The routine will loop 1103 times before providing me with the error.

Thanks for your time.
Pace

the code should close and destroy all references to the objects it
opens. So if you open an object, like a recordset, at the end of the
code, there should be a statement like

rst.CLOSE
set rst=Nothing

this removes the recordset from memory, and the connection to the
table.

Once you do that, your code should be fine.
 
Ad

Advertisements

A

Alex Dybenko

Hi,
perhaps this one:
http://accessblog.net/2005/12/be-careful-using-currentdb.html

--
Best regards,
___________
Alex Dybenko (MVP)
http://accessblog.net
http://www.PointLtd.com

Pace said:
Hey all,

I am receiving this error when i'm trying to run a routine that I didn't
create. I know this should be a sp on my sql box but I haven't got the
resource to do it right now.

Basically I know that access is struggling not creating tables, but table
references, I have tried all the ms knowledge base and newsgroups and I
don't
seem to be able to find any adequate reference material to try solve this.
I
have been through the code trying to make sure that all my recordsets and
querydef objects are being explicitly closed, yet I cannot seem to past
1103
records of the 3000 I need to process. It stops consistently at the same
point. I am using jet4.0 vanilla that comes with xp sp2;

here is my entire forms code, yes, there is DAO in there, im in the
process
of re-writing the whole system;

Code:
Option Compare Database
Option Explicit

Dim lUpdateID As Long

Private Sub CloseButton_Click()
DoCmd.Close
End Sub

Private Sub OKButton_Click()
Dim rst As DAO.Recordset
Dim rstP As DAO.Recordset
Dim strSQL As String
Dim strAssembly As String
Dim strComponent As String
Dim sngQty As Single
Dim SubAssemblyCost As Single
Dim I As Integer
Dim iRecords As Long
Dim dblPerCent As Double

Dim strNowTime As String
Dim dtStartTime As Date
Dim Elapsed As String
Dim EstFinish As String

DoCmd.Hourglass True
'  lUpdateID = 111

strSQL = "SELECT [Product Code] FROM Product " & _
"WHERE Assembly = True"
Set rstP = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset,
[dbSeeChanges])
rstP.MoveLast
iRecords = rstP.RecordCount
rstP.MoveFirst

dtStartTime = Time
strNowTime = CStr(Time)
EstFinish = CStr(dtStartTime + 30)

Me!StartLabel.Caption = strNowTime

For I = 1 To iRecords
strAssembly = rstP![Product Code]
Me!ProdLabel.Caption = strAssembly
Me!RecordLabel.Caption = I & " of " & iRecords
dblPerCent = CDbl(I * (100 / iRecords))
Me!PercentLabel.Caption = Format(dblPerCent, "##") & "%"
Me.Repaint
If I Mod 10 = 0 Then
DoEvents
End If
strSQL = "SELECT * FROM BOMData " & _
"WHERE Parent = """ & strAssembly & """"
Set rst = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset,
[dbSeeChanges])
If rst.EOF = True Then
rst.Close
Else
SubAssemblyCost = 0
Do While rst.EOF = False
sngQty = GetSubCost(rst!Component)
If sngQty = 999999 Then
sngQty = GetProductCost(rst!Component)
If rst!Assembly = True Then
rst.Edit
rst!Assembly = False
rst.Update
End If
Else
UpdateProductCost rst!Component, sngQty
If rst!Assembly = False Then
rst.Edit
rst!Assembly = True
rst.Update
End If
End If
SubAssemblyCost = SubAssemblyCost + sngQty * rst!Qty
rst.MoveNext
Loop
rst.Close
UpdateProductCost strAssembly, SubAssemblyCost
End If

rstP.MoveNext
Elapsed = Time - dtStartTime
EstFinish = iRecords * Elapsed / I
Me!FinishLabel.Caption = CStr(EstFinish + dtStartTime)
Next I
rstP.Close
DoCmd.Hourglass False
MsgBox "Finished at " & Time
DoCmd.Close
End Sub

Function GetSubCost(strCode)
Dim rst As DAO.Recordset
Dim strSQL As String
Dim sngQty As Single
Dim SubAssemblyCost As Single

'  strSQL = "SELECT * FROM BOMData " & _
"WHERE Parent = """ & strCode & """"
strSQL = "SELECT Product.[Product Code], BOMData.Component, BOMData.Qty,
"
& _
"BOMData.Assembly " & _
"FROM Product INNER JOIN BOMData ON Product.[Product Code] =
BOMData.Parent " & _
"WHERE (((Product.[Product Code])=""" & strCode & """) AND
((Product.SparesOnly)=False));"
Set rst = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset,
[dbSeeChanges])
If rst.EOF = True Then
rst.Close
GetSubCost = 999999
Exit Function
End If
SubAssemblyCost = 0
Do While rst.EOF = False
sngQty = GetSubCost(rst!Component)
If sngQty = 999999 Then
sngQty = GetProductCost(rst!Component)
If rst!Assembly = True Then
rst.Edit
rst!Assembly = False
rst.Update
End If
Else
UpdateProductCost rst!Component, sngQty
If rst!Assembly = False Then
rst.Edit
rst!Assembly = True
rst.Update
End If
End If
SubAssemblyCost = SubAssemblyCost + sngQty * rst!Qty
rst.MoveNext
Loop

rst.Close
GetSubCost = SubAssemblyCost
End Function

Function GetProductCost(strCode)
Dim rstP As DAO.Recordset
Dim strSQL As String

strSQL = "SELECT Cost FROM Product " & _
"WHERE [Product Code] = """ & strCode & """"
Set rstP = CurrentDb.OpenRecordset((strSQL), dbOpenDynaset,
[dbSeeChanges])
If rstP.EOF = False Then GetProductCost = Nz(rstP!Cost)
rstP.Close
End Function

Function UpdateProductCost(strCode As String, cCost As Single)
Dim strSQL As String
Dim qdfChange As QueryDef

strSQL = "UPDATE Product SET Cost = " & cCost & _
" WHERE [SparesOnly] = False AND [Product Code] = """ & strCode & """"

Set qdfChange = CurrentDb.CreateQueryDef("", strSQL)
qdfChange.Execute
'barry - closing objects
qdfChange.Close
Set qdfChange = Nothing

End Function

The routine will loop 1103 times before providing me with the error.

Thanks for your time.
Pace
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top