Over the past few days I worked on this problem and found a pretty solid solution. Hopefully no one cringers at my novice VBA skills.
There's a lot of extraneous extra steps I had to take to get the result I wanted. But in the abstract it was fairly straight forward. I ended up creating a table called BOR to store my exploded BOM data. The first part of the process found all of the end products and wrote those into the BOR file. I created a new hierarchy field called the BORLevel. All of the end items were given a BORLevel of 0.
The second part of thisThe BOR file had both the finished good and subordinate. In the next part I referenced the subordinate back to the BOM file and returned the next level which was written into the BOR file. This was given a BORLevel of 1. This process just loops 30 times.
I hope in the future someone finds this useful. Being able to auto explode a bill of material is pretty powerful and very use full. Although being a systems guy I have to say that it's a lot more practical to do in your MRP/ERP/Planning system. But I don't have the luxury of having a well oiled ERP system.
Below is my code.
Public Sub BOR_Explosion()
Dim db As DAO.Database, RecCount As Long
Dim LVLCount As Integer
Dim I
Dim LVLHeir As Integer
'Get the total number of records for the import table
RecCount = DCount("*", "BOR")
'Calls the current DB
Set db = CurrentDb
'Inserts the first level and sets the BORLevel to 0
db.Execute "INSERT INTO [BOR] ( Item, Loc, BORLevel, Parent, Subord, SUBORDDraw, PRODMeth, Priority, Res, FixedResReq, ProdRate, PARENTDraw, NLFactor ) " & _
"SELECT ProductionMethod.Item, ProductionMethod.Loc, '0' AS BORLevel, ProductionMethod.Item, BOM.Subord, BOM.DrawQty, ProductionMethod.ProductionMethod, Min(ProductionMethod.Priority) AS MinOfPriority, ProductionStep.Res, ProductionStep.FixedResReq, ProductionStep.ProdRate, 1 AS PARENTDraw, 1*[drawqty] AS NLFactor " & _
"FROM BOR_SKUIDS_001 INNER JOIN ((ProductionMethod LEFT JOIN BOM ON (ProductionMethod.Item = BOM.Item) AND (ProductionMethod.Loc = BOM.Loc) AND (ProductionMethod.BOMNum = BOM.BOMNum)) INNER JOIN ProductionStep ON (ProductionMethod.Loc = ProductionStep.Loc) AND (ProductionMethod.Item = ProductionStep.Item) AND (ProductionMethod.ProductionMethod = ProductionStep.ProductionMethod)) ON BOR_SKUIDS_001.Item = ProductionMethod.Item " & _
"GROUP BY ProductionMethod.Item, ProductionMethod.Loc, '0', ProductionMethod.Item, BOM.Subord, BOM.DrawQty, ProductionMethod.ProductionMethod, ProductionStep.Res, ProductionStep.FixedResReq, ProductionStep.ProdRate, 1, 1*[drawqty]; ", dbFailOnError
'db.RecordsAffected now contains the number of records that were inserted above
' since CurrentDb returns a new db object, CurrentDb.RecordsAffected always = 0
If RecCount = db.RecordsAffected Then
db.Execute "DELETE * FROM BOR", dbFailOnError
End If
'
'
'Now starts the repeat
'
'
'Start the looping
For I = 1 To 30
'Finds the greates BORlevel and adds 1
LVLCount = DMax("[BORLevel]", "BOR") + 1
LVLHeir = DMax("[BORLevel]", "BOR")
'Get the total number of records for the import table
RecCount = DCount("*", "BOR")
'Calls the current DB
Set db = CurrentDb
'Inserts the first level and incrementally adds 1 to each BORLevel
db.Execute "INSERT INTO [BOR] ( Item, Loc, BORLevel, Parent, Subord, SUBORDDraw, PRODMeth, Priority, Res, FixedResReq, ProdRate, PARENTDraw, NLFactor ) " & _
"SELECT [BOR].Item, [BOR].Loc, " & LVLCount & " AS BORLevel, [BOR].Subord, BOM.Subord, BOM.DrawQty, ProductionMethod.ProductionMethod, Min(ProductionMethod.Priority) AS MinOfPriority, ProductionStep.Res, ProductionStep.FixedResReq, ProductionStep.ProdRate, [BOR].NLFactor AS PARENTDraw, [BOR].[NLFactor]*[drawqty] AS NLFactor " & _
"FROM [BOR] INNER JOIN ((ProductionMethod LEFT JOIN BOM ON (ProductionMethod.BOMNum = BOM.BOMNum) AND (ProductionMethod.Loc = BOM.Loc) AND (ProductionMethod.Item = BOM.Item)) INNER JOIN ProductionStep ON (ProductionMethod.ProductionMethod = ProductionStep.ProductionMethod) AND (ProductionMethod.Item = ProductionStep.Item) AND (ProductionMethod.Loc = ProductionStep.Loc)) ON ([BOR].Loc = ProductionMethod.Loc) AND ([BOR].Subord = ProductionMethod.Item) " & _
"GROUP BY [BOR].Item, [BOR].BORLevel, [BOR].Loc, " & LVLCount & ", [BOR].Subord, BOM.Subord, BOM.DrawQty, ProductionMethod.ProductionMethod, ProductionStep.Res, ProductionStep.FixedResReq, ProductionStep.ProdRate, [BOR].NLFactor, [BOR].[NLFactor]*[drawqty] " & _
"HAVING [BOR].BORLevel=" & LVLHeir & " AND BOM.Subord Is Not Null; ", dbFailOnError
'db.RecordsAffected now contains the number of records that were inserted above
' since CurrentDb returns a new db object, CurrentDb.RecordsAffected always = 0
If RecCount = db.RecordsAffected Then
db.Execute "DELETE * FROM BOR", dbFailOnError
End If
'Ends looping
Next I
MsgBox "Bill of Resources file has been built."
End Sub
