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