VBA - Counting quantity of parts in assemblies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I'm trying to make a list of part numbers, descriptions, and quantities so I can import it into an erp program. The issue I'm running into is getting the total quantity of a part in an assembly and all of it's sub-assemblies. I've modified some example code that created a bom list from the help. However going through the bom will not give a total number for the quantity of parts. Going through the bom list will only give the quantity of parts in a single assembly and not multiply the quantities if that assembly is used multiple times. I figure it would be possible if an assembly was used twice to remember that and then multiple all subcomponet quantities by two, but a simplier way would be nice.
Example:
Main assembly
Sub-A
Part1
Sub-A
Part1
The bom code would list one Main assembly, two Sub-A, and one Part1.
Is there an easy way to count the total number of occurances of a part in an assembly and all sub-assemblies? I don't need any type of structured list as I will be sorting everything by part number afterwards. Thanks
Original BOM code example (sorry it wasn't indented where I got it)
Public Sub BOMQuery()
' Set a reference to the assembly document.
' This assumes an assembly document is active.
Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument
Dim FirstLevelOnly As Boolean
If MsgBox("First level only?", vbYesNo) = vbYes Then
FirstLevelOnly = True
Else
FirstLevelOnly = False
End If
' Set a reference to the BOM
Dim oBOM As BOM
Set oBOM = oDoc.ComponentDefinition.BOM
' Set whether first level only or all levels.
If FirstLevelOnly Then
oBOM.StructuredViewFirstLevelOnly = True
Else
oBOM.StructuredViewFirstLevelOnly = False
End If
' Make sure that the structured view is enabled.
oBOM.StructuredViewEnabled = True
'Set a reference to the "Structured" BOMView
Dim oBOMView As BOMView
Set oBOMView = oBOM.BOMViews.Item("Structured")
Debug.Print "Item"; Tab(15); "Quantity"; Tab(30); "Part Number"; Tab(70); "Description"
Debug.Print "----------------------------------------------------------------------------------"
'Initialize the tab for ItemNumber
Dim ItemTab As Long
ItemTab = -3
Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab)
End Sub
Private Sub QueryBOMRowProperties(oBOMRows As BOMRowsEnumerator, ItemTab As Long)
ItemTab = ItemTab + 3
' Iterate through the contents of the BOM Rows.
Dim i As Long
For i = 1 To oBOMRows.Count
' Get the current row.
Dim oRow As BOMRow
Set oRow = oBOMRows.Item(i)
'Set a reference to the primary ComponentDefinition of the row
Dim oCompDef As ComponentDefinition
Set oCompDef = oRow.ComponentDefinitions.Item(1)
Dim oPartNumProperty As Property
Dim oDescripProperty As Property
If Typeof oCompDef Is VirtualComponentDefinition Then
'Get the file property that contains the "Part Number"
'The file property is obtained from the virtual component definition
Set oPartNumProperty = oCompDef.PropertySets _
.Item("Design Tracking Properties").Item("Part Number")
'Get the file property that contains the "Description"
Set oDescripProperty = oCompDef.PropertySets _
.Item("Design Tracking Properties").Item("Description")
Debug.Print Tab(ItemTab); oRow.ItemNumber; Tab(17); oRow.ItemQuantity; Tab(30); _
oPartNumProperty.Value; Tab(70); oDescripProperty.Value
Else
'Get the file property that contains the "Part Number"
'The file property is obtained from the parent
'document of the associated ComponentDefinition.
Set oPartNumProperty = oCompDef.Document.PropertySets _
.Item("Design Tracking Properties").Item("Part Number")
'Get the file property that contains the "Description"
Set oDescripProperty = oCompDef.Document.PropertySets _
.Item("Design Tracking Properties").Item("Description")
Debug.Print Tab(ItemTab); oRow.ItemNumber; Tab(17); oRow.ItemQuantity; Tab(30); _
oPartNumProperty.Value; Tab(70); oDescripProperty.Value
'Recursively iterate child rows if present.
If Not oRow.ChildRows Is Nothing Then
Call QueryBOMRowProperties(oRow.ChildRows, ItemTab)
End If
End If
Next
ItemTab = ItemTab - 3
End Sub
