Runtime error 3014 - Can't open more tables - ADO DAO RDO RDS

This is a discussion on Runtime error 3014 - Can't open more tables - ADO DAO RDO RDS ; 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. ...

+ Reply to Thread
Results 1 to 4 of 4

Runtime error 3014 - Can't open more tables

  1. Default Runtime error 3014 - Can't open more tables

    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

  2. Default Re: Runtime error 3014 - Can't open more tables

    On Oct 23, 8:26 am, Pace <P...@discussions.microsoft.com> wrote:
    > 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.


  3. Default Re: Runtime error 3014 - Can't open more tables

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

    "pietlinden@hotmail.com" wrote:

    > On Oct 23, 8:26 am, Pace <P...@discussions.microsoft.com> wrote:
    > > 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.
    >
    >


  4. Default Re: Runtime error 3014 - Can't open more tables

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

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

    "Pace" <Pace@discussions.microsoft.com> wrote in message
    news:7CD71705-B67E-4B79-8840-E0D7A7A2F3EF@microsoft.com...
    > 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



+ Reply to Thread

Similar Threads

  1. Linking tables in access 2007 runtime
    By Application Development in forum ADO DAO RDO RDS
    Replies: 1
    Last Post: 10-18-2007, 04:53 AM
  2. oracle tables - dynamic odbc relinking while runtime
    By Application Development in forum ADO DAO RDO RDS
    Replies: 0
    Last Post: 07-13-2007, 08:10 AM
  3. Replies: 0
    Last Post: 12-12-2006, 09:26 AM
  4. Replies: 0
    Last Post: 12-12-2006, 08:28 AM
  5. Re: 3240 runtime error: database still open
    By Application Development in forum ADO DAO RDO RDS
    Replies: 0
    Last Post: 01-08-2004, 07:57 AM