Jim Dettman
jimdettman at verizon.net
Sun Jul 26 09:10:56 CDT 2009
Tom,
Access with either a JET/ACE or SQL Server data store is more then
adequate for doing complex BOM assemblies.
I have 3 BOM samples here; two are SQL based and one VBA code. The last
was used as the basis for a short article written by Miriam Bizup on
Experts-Exchange.com. The article is going through some finial editing at
the moment and hasn't been published yet, but I can forward a copy off-line
as well as the BOM samples.
The code in her article is slightly different then mine as it's something
she wrote based on the VBA solution I gave her about 3-4 years ago, but in
general the logic is the same.
Below I've pasted in the VBA code for the routine (the sample has the
tables and some data and is workable). Note that it uses a goto and a gosub
within the procedure in order to avoid a recursive call (Miriam's code uses
a recursive call, which is why it's slightly different). I did this on
purpose as the code was a port from another language 15 years ago and back
then it was always a good idea to avoid filling up the stack as much as
possible.
Jim.
Public Function ExplodeBOM(strPartID As String, dblQuantity As Double) As
Integer
Dim dbCur As Database
Dim rstParts As Recordset
Dim rstBOM As Recordset
Dim rstExploded As Recordset
Dim lngDisplayOrder As Long
Dim intCurLevel As Integer
Dim strParts(255) As String
Dim lngCurLine(255) As Long
Dim dblQPA(255) As Double
Dim dblQtyRequired As Double
Dim dblHoldQPA As Double
Dim intJ As Integer
Set dbCur = CurrentDb()
Set rstParts = dbCur.OpenRecordset("tblPartMaster", dbOpenTable)
rstParts.Index = "PrimaryKey"
Set rstBOM = dbCur.OpenRecordset("tblBOM", dbOpenTable)
rstBOM.Index = "PrimaryKey"
Set rstExploded = dbCur.OpenRecordset("tblBOMExploded")
ExplodeBOM = False
' First clear BOM explosion table.
On Error GoTo ExplodeBOM_ErrDelete
dbCur.Execute "DELETE * FROM tblBOMExploded", dbFailOnError
On Error GoTo 0
' Find part in part master
rstParts.Seek "=", strPartID
If rstParts.NoMatch Then
MsgBox "Part: " & strPartID & " cannot be found. "
GoTo ExplodeBOM_Leave
End If
' Find top level assembly, first line
rstBOM.Seek "=", strPartID, 1
If rstBOM.NoMatch Then
MsgBox "Part: " & strPartID & " is not an assembly. "
GoTo ExplodeBOM_Leave
End If
' Initialize for top level
intCurLevel = 1
Erase strParts()
Erase lngCurLine()
Erase dblQPA()
lngDisplayOrder = 0
strParts(intCurLevel) = strPartID
lngCurLine(intCurLevel) = 0
dblQPA(intCurLevel) = dblQuantity
' Level loop
' Get next line from BOM.
ExplodeBOM_GetNextLine:
lngCurLine(intCurLevel) = lngCurLine(intCurLevel) + 1
rstBOM.Seek "=", strParts(intCurLevel), lngCurLine(intCurLevel)
If rstBOM.NoMatch Then
' Go up one level
If intCurLevel = 1 Then
ExplodeBOM = True
GoTo ExplodeBOM_Leave
Else
intCurLevel = intCurLevel - 1
GoTo ExplodeBOM_GetNextLine
End If
Else
' Have another line. Is there a BOM for it?
GoSub ExplodeBOM_WriteLine
dblHoldQPA = rstBOM![QPA]
rstBOM.Seek "=", rstBOM![PartID], 1
If rstBOM.NoMatch Then
' Raw material or purchased componet
GoTo ExplodeBOM_GetNextLine
Else
' Have another assembly. Drop a Level
intCurLevel = intCurLevel + 1
If intCurLevel > 20 Then
MsgBox "Explosion greater then 20 levels - Circular reference"
GoTo ExplodeBOM_Leave
Else
strParts(intCurLevel) = rstBOM![AssemblyID]
lngCurLine(intCurLevel) = 0
dblQPA(intCurLevel) = dblHoldQPA
GoTo ExplodeBOM_GetNextLine
End If
End If
End If
ExplodeBOM_Leave:
If Not rstExploded Is Nothing Then
rstExploded.Close
Set rstExploded = Nothing
End If
If Not rstParts Is Nothing Then
rstParts.Close
Set rstParts = Nothing
End If
If Not rstBOM Is Nothing Then
rstBOM.Close
Set rstBOM = Nothing
End If
If Not dbCur Is Nothing Then
Set dbCur = Nothing
End If
Exit Function
ExplodeBOM_CalQTYReq:
dblQtyRequired = 1
For intJ = 1 To intCurLevel: dblQtyRequired = dblQtyRequired *
dblQPA(intJ): Next intJ
dblQtyRequired = dblQtyRequired * rstBOM![QPA]
Return
ExplodeBOM_WriteLine:
GoSub ExplodeBOM_CalQTYReq
lngDisplayOrder = lngDisplayOrder + 1
rstExploded.AddNew
rstExploded![DisplayOrder] = lngDisplayOrder
rstExploded![Level] = intCurLevel
rstExploded![Sequence] = lngCurLine(intCurLevel)
rstExploded![PartID] = rstBOM![PartID]
rstExploded![QtyRequired] = dblQtyRequired
rstExploded.Update
Return
ExplodeBOM_ErrDelete:
MsgBox "Could not clear BOM Exploded table"
Resume ExplodeBOM_Leave
End Function
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Thomas Ewald
Sent: Saturday, July 25, 2009 4:44 PM
To: accessd at databaseadvisors.com
Subject: [AccessD] Why no BOM on MSDN for Access?
Microsoft includes a bill of material set of procedures in its
AdventureWorks sample database for SQL Server (listed on msdn), and mentions
Dynamics a lot, but lists nothing similar that I can find for Access at all.
I have found a little about it here are there on the Web, but not much. May
I ask the opinions of those on this list? Is Access inappropriate for a
complex exploding bill of material application?
Thanks.
Tom Ewald
Detroit Area
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com