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;
The routine will loop 1103 times before providing me with the error.
Thanks for your time.
Pace
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 FunctionThe routine will loop 1103 times before providing me with the error.
Thanks for your time.
Pace