[AccessD] Why no BOM on MSDN for Access?

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




More information about the AccessD mailing list