M
msnews
I've modified the BOM code from the Access Web (originally authored by
Robin Stoddart-Stones) to work with an existing, linked Access 97 table
(the tables will soon be converted to Access 2000 format) that's maintained
by another program. Problem is it's ~very~ slow. Can anyone give me some
pointers on how to speed things up? I'm quite comfortable in VB but Access
is a bit foreign to me...
Here's the BAS module listing. PN and PL are the A97 linked tables and
OUTPUT is stored in the mdb from which this is run. Any comments would be
welcome...
Attribute VB_Name = "Bom1"
Option Compare Database
Option Explicit
Const Qu = """"
Type typBits
Component As Long
NumberOF As Single
End Type
Dim strTopLevelPN As String
Public Function BOMHost()
Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim iArray() As typBits
Dim strAssemblyP As Long
Dim fDone As Integer
Dim iCurrent As Integer
Dim intMultiplier As Single
Dim strSQL As String
Set db1 = CurrentDb()
strSQL = "select PN.PNUser5, PN.PNID from PN where " _
& "(((PN.PNUser5)<> " & Qu & Qu & ") and (PN.PNPLType <> " & Qu & "PS" & Qu
& " ))"
Set rs2 = db1.OpenRecordset("select PN.PNUser5, PN.PNID from PN where " _
& "(((PN.PNUser5)<> " & Qu & Qu & ") and (PN.PNType <> " & Qu & "PS" & Qu &
" ))", DB_OPEN_DYNASET)
DoCmd.RunSQL ("Delete *.* from OutPutTable") ' clear the outputTable
rs2.MoveFirst
Do Until rs2.EOF
strAssemblyP = rs2!PNID
strTopLevelPN = rs2!PNUser5
'Erase iArray
ReDim iArray(0)
fDone = False
iCurrent = 0
intMultiplier = 1
If GetSubAssembly(strAssemblyP, db1, rs1) = 0 Then
fDone = True
GoTo BOMHost_End
End If
'Set up the array for the item you wish to decompose.
ParseList iArray(), rs1, UBound(iArray), intMultiplier
Do Until fDone
'Take the next item in the array, (for the first item, the next item
is the
'first unit in the array). Gets the constituent items from the
assembly table referencing
'the parentID. If the item has subcomponents then the item can be
decomposed further.
' if the item is a component (no further decomposition) then it goes
to Output.
'Otherwise it is a subAssembly and you add the parts to the array
using ParseList.
If GetSubAssembly(iArray(iCurrent).Component, db1, rs1) = 0 Then
AddtoOutput db1, iArray, iCurrent
Else
intMultiplier = iArray(iCurrent).NumberOF
ParseList iArray(), rs1, UBound(iArray), intMultiplier
End If
'That has finished the processing for the item in the array, so
increment the pointer to
'your current position and test to see if you have finished.( your
current pointer is now
'equal to the array UBound). ' if not go back and do the next Item,
'if so then Output Table contains the BillOfMaterials list and you
are finished.
iCurrent = iCurrent + 1
If iCurrent = UBound(iArray) Then fDone = True
DoEvents
Loop
BOMHost_End:
rs2.MoveNext
Debug.Print rs2.AbsolutePosition, rs2.RecordCount
Loop
MsgBox "Completed"
db1.Close
End Function
Private Function GetSubAssembly(strParentID As Long, db1 As Database, rs1 As
Recordset) As Integer
' returns 0 if no records, else 1 (doesn't move to end of recordset)
Set rs1 = db1.OpenRecordset("select PL.PLPartID,PL.PLQty from PL where " _
& "(((PL.PLListID)=" & strParentID & "))", DB_OPEN_DYNASET)
GetSubAssembly = rs1.RecordCount
End Function
'Gets the individual records from rs1 (argument recordset) and puts them
into the array
Private Sub ParseList(iArray() As typBits, rs1 As Recordset, intLastPosition
As Integer, intMultiplier As Single)
Dim intSize As Integer
'iArray() is integer array defined in the host procedure
'rs1 the recordset to get data from
'intLastPosition the last position in the array
' intMultiplier is the multiplying factor based on the number of parent
units required
intSize = intLastPosition + 1
Do Until rs1.EOF
ReDim Preserve iArray(intSize)
iArray(intLastPosition).Component = rs1!PLPartID
If IsNull(rs1!PLQty) Then
'do nothing...
'leave the field empty
Else
iArray(intLastPosition).NumberOF = rs1!PLQty * intMultiplier
End If
rs1.Move 1
intSize = intSize + 1
intLastPosition = intLastPosition + 1
Loop
End Sub
'Components are added to the output table . Modify this module to modify
Output
Private Sub AddtoOutput(db1 As Database, iArray() As typBits, iICurrent As
Integer)
Dim rs1 As Recordset
Dim strAssemblyID As Long
Dim intNumberOf As Single
strAssemblyID = iArray(iICurrent).Component
intNumberOf = iArray(iICurrent).NumberOF
Set rs1 = db1.OpenRecordset("select OutPutTable.* from OutputTable",
DB_OPEN_DYNASET)
rs1.AddNew
rs1!BOMPN = strAssemblyID
rs1!BOMQty = intNumberOf
rs1!TopLevelPN = strTopLevelPN
rs1.Update
End Sub
Robin Stoddart-Stones) to work with an existing, linked Access 97 table
(the tables will soon be converted to Access 2000 format) that's maintained
by another program. Problem is it's ~very~ slow. Can anyone give me some
pointers on how to speed things up? I'm quite comfortable in VB but Access
is a bit foreign to me...
Here's the BAS module listing. PN and PL are the A97 linked tables and
OUTPUT is stored in the mdb from which this is run. Any comments would be
welcome...
Attribute VB_Name = "Bom1"
Option Compare Database
Option Explicit
Const Qu = """"
Type typBits
Component As Long
NumberOF As Single
End Type
Dim strTopLevelPN As String
Public Function BOMHost()
Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim iArray() As typBits
Dim strAssemblyP As Long
Dim fDone As Integer
Dim iCurrent As Integer
Dim intMultiplier As Single
Dim strSQL As String
Set db1 = CurrentDb()
strSQL = "select PN.PNUser5, PN.PNID from PN where " _
& "(((PN.PNUser5)<> " & Qu & Qu & ") and (PN.PNPLType <> " & Qu & "PS" & Qu
& " ))"
Set rs2 = db1.OpenRecordset("select PN.PNUser5, PN.PNID from PN where " _
& "(((PN.PNUser5)<> " & Qu & Qu & ") and (PN.PNType <> " & Qu & "PS" & Qu &
" ))", DB_OPEN_DYNASET)
DoCmd.RunSQL ("Delete *.* from OutPutTable") ' clear the outputTable
rs2.MoveFirst
Do Until rs2.EOF
strAssemblyP = rs2!PNID
strTopLevelPN = rs2!PNUser5
'Erase iArray
ReDim iArray(0)
fDone = False
iCurrent = 0
intMultiplier = 1
If GetSubAssembly(strAssemblyP, db1, rs1) = 0 Then
fDone = True
GoTo BOMHost_End
End If
'Set up the array for the item you wish to decompose.
ParseList iArray(), rs1, UBound(iArray), intMultiplier
Do Until fDone
'Take the next item in the array, (for the first item, the next item
is the
'first unit in the array). Gets the constituent items from the
assembly table referencing
'the parentID. If the item has subcomponents then the item can be
decomposed further.
' if the item is a component (no further decomposition) then it goes
to Output.
'Otherwise it is a subAssembly and you add the parts to the array
using ParseList.
If GetSubAssembly(iArray(iCurrent).Component, db1, rs1) = 0 Then
AddtoOutput db1, iArray, iCurrent
Else
intMultiplier = iArray(iCurrent).NumberOF
ParseList iArray(), rs1, UBound(iArray), intMultiplier
End If
'That has finished the processing for the item in the array, so
increment the pointer to
'your current position and test to see if you have finished.( your
current pointer is now
'equal to the array UBound). ' if not go back and do the next Item,
'if so then Output Table contains the BillOfMaterials list and you
are finished.
iCurrent = iCurrent + 1
If iCurrent = UBound(iArray) Then fDone = True
DoEvents
Loop
BOMHost_End:
rs2.MoveNext
Debug.Print rs2.AbsolutePosition, rs2.RecordCount
Loop
MsgBox "Completed"
db1.Close
End Function
Private Function GetSubAssembly(strParentID As Long, db1 As Database, rs1 As
Recordset) As Integer
' returns 0 if no records, else 1 (doesn't move to end of recordset)
Set rs1 = db1.OpenRecordset("select PL.PLPartID,PL.PLQty from PL where " _
& "(((PL.PLListID)=" & strParentID & "))", DB_OPEN_DYNASET)
GetSubAssembly = rs1.RecordCount
End Function
'Gets the individual records from rs1 (argument recordset) and puts them
into the array
Private Sub ParseList(iArray() As typBits, rs1 As Recordset, intLastPosition
As Integer, intMultiplier As Single)
Dim intSize As Integer
'iArray() is integer array defined in the host procedure
'rs1 the recordset to get data from
'intLastPosition the last position in the array
' intMultiplier is the multiplying factor based on the number of parent
units required
intSize = intLastPosition + 1
Do Until rs1.EOF
ReDim Preserve iArray(intSize)
iArray(intLastPosition).Component = rs1!PLPartID
If IsNull(rs1!PLQty) Then
'do nothing...
'leave the field empty
Else
iArray(intLastPosition).NumberOF = rs1!PLQty * intMultiplier
End If
rs1.Move 1
intSize = intSize + 1
intLastPosition = intLastPosition + 1
Loop
End Sub
'Components are added to the output table . Modify this module to modify
Output
Private Sub AddtoOutput(db1 As Database, iArray() As typBits, iICurrent As
Integer)
Dim rs1 As Recordset
Dim strAssemblyID As Long
Dim intNumberOf As Single
strAssemblyID = iArray(iICurrent).Component
intNumberOf = iArray(iICurrent).NumberOF
Set rs1 = db1.OpenRecordset("select OutPutTable.* from OutputTable",
DB_OPEN_DYNASET)
rs1.AddNew
rs1!BOMPN = strAssemblyID
rs1!BOMQty = intNumberOf
rs1!TopLevelPN = strTopLevelPN
rs1.Update
End Sub