Method to exclude number sequence in BOM export to Excel

[brendan.henderson]

Hi All. I'm a relatively newbie to VBA code but I have managed to patch together a macro that when run from an assembly document populates an excel document with the QTY, STOCK NUMBER and DESCRIPTION of the parts. This works well.

I now just need to tidy it up by EXCLUDING some parts from the list. I need to exclude andy ietsm that DO NOT have a Stock Number and also EXCLUDE all items where the Stock Number starts with 01000 or larger. I'm thinking I need to either put this into the below code which does the occurence count and stuff, or as I select the range at the end of the macro, somehow run a filter to delete these rows. B Currently i'm just putting up a message box telling the document creator to manually delete these rows. Below is the code I am using so far (I will also accept any comments about the code as it is-remember I have pieced this together from various other sources and have little VBA experience ).

Sub AssyBOM2Excel()

Dim oAssDoc As AssemblyDocument
Set oAssDoc = ThisApplication.ActiveDocument

If oAssDoc.DocumentType <> kAssemblyDocumentObject Then
    MsgBox "The Active document must be an 'Assembly'!"
    Exit Sub
End If

Dim oDocs As DocumentsEnumerator
Set oDocs = oAssDoc.AllReferencedDocuments

Dim oDoc As Document

Dim row As Integer
Dim excel_app As Excel.Application

app2check = "Excel.Application"
If IsApplicationRunning(app2check) = True Then
    Set excel_app = Excel.Application
Else
    Set excel_app = CreateObject("Excel.Application")
End If

excel_app.Visible = True
excel_app.Workbooks.Add

With excel_app
    .Columns("A:A").ColumnWidth = 20
    .Range("A1").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    .ActiveCell.FormulaR1C1 = "ASSEMBLY 'BOUGHT' PARTS LIST"
    
    .Columns("A:A").ColumnWidth = 20
    .Range("A2").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -6279056
        .TintAndShade = 0
    End With
    .ActiveCell.FormulaR1C1 = "If the Assembly No. below does not end in -00000 then the QTY's shown may be wrong as this list has been generated from a sub-assembly!"
    
    .Columns("A:A").ColumnWidth = 20
    .Range("A3").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    .ActiveCell.FormulaR1C1 = "This list shows only BOUGHT items and DOES NOT include Sheet Metal or Plasma items."
    
    .Range("A5").Select
    .ActiveCell.FormulaR1C1 = "ASSEMBLY No. - " & Left(oAssDoc.DisplayName, Len(oAssDoc.DisplayName) - 4)

    .Range("A6").Select
    .ActiveCell.FormulaR1C1 = "Stock Code"

    .Columns("B:B").ColumnWidth = 10
    .Range("B6").Select
    .ActiveCell.FormulaR1C1 = "Qty"

    .Columns("C:C").ColumnWidth = 105
    .Range("C6").Select
    .ActiveCell.FormulaR1C1 = "Description"

row = 6

For Each oDoc In oDocs

    'revFlag = 0

    Dim oOccs As ComponentOccurrencesEnumerator
    Set oOccs = oAssDoc.ComponentDefinition.Occurrences.AllReferencedOccurrences(oDoc)

    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets

    Dim oProp1 As Property
    Set oProp1 = oPropSets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kStockNumberDesignTrackingProperties)
    oStockNumber = oProp1.Value
    
    Dim oProp2 As Property
    Set oProp2 = oPropSets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kDescriptionDesignTrackingProperties)
    oDescription = oProp2.Value
                   
        If oOccs.Count <> 0 Then
            row = row + 1
            With excel_app
                .Range("A" & Format$(row)).Select
                .ActiveCell.FormulaR1C1 = oStockNumber
                .Range("B" & Format$(row)).Select
                .ActiveCell.FormulaR1C1 = oOccs.Count
                .Range("C" & Format$(row)).Select
                .ActiveCell.FormulaR1C1 = oDescription
            End With
        End If
Next

'With excel_app
    'sortRange = "A7:C" & row
    '.Range(sortRange).Select
    'Sleep 500
    '.Selection.Sort Key1:=Range("A7"), Order1:=xlAscending
'End With

'add blue to stock/qty/desc row
With Worksheets("Sheet1").Cells
    With .FormatConditions
      .Delete
      .Add Type:=xlExpression, Formula1:="=ROW()=6"
    End With
    .FormatConditions(1).Interior.ColorIndex = 33
End With

With Worksheets("Sheet1").Cells
    N = 7
    For Each VisRow In Selection.Resize(, 1).SpecialCells(xlCellTypeVisible)
        N = N + 1
        If N Mod 2 = 0 Then
            VisRow.EntireRow.Interior.ColorIndex = 15
        End If
    Next VisRow
End With

With excel_app
    sortRange = "A7:C" & row
    .Range(sortRange).Select
    Sleep 500
    .Selection.Sort Key1:=Range("A7"), Order1:=xlAscending
End With

End With

If oAssDoc.DocumentType = kAssemblyDocumentObject Then
    MsgBox "Before printing the Parts List delete all rows with blank STOCK CODE numbers and those with STOCK CODE numbers larger than 00999-99999", vbExclamation
    'Exit Sub
End If

End Sub

[xiaodong_liang]

Hi,

Hope the following code helps.

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")
       
    Dim i As Long
    For i = 1 To oBOMView.BOMRows.Count
         Dim oRow As BOMRow
        Set oRow = oBOMView.BOMRows.Item(i)
       
         Dim oCompDef As ComponentDefinition
        Set oCompDef = oRow.ComponentDefinitions.Item(1)
       
 
 
        Dim oStockNumProperty As Property
     
         If TypeOf oCompDef Is VirtualComponentDefinition Then
              Set oStockNumProperty = oCompDef.PropertySets _
                .Item("Design Tracking Properties").Item("Stock Number")

         Else
        
           Set oStockNumProperty = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Stock Number")
         End If
     
          If oStockNumProperty.Value = "" Or oStockNumProperty.Value > 100 Then
             MsgBox "EXCLUDE THIS PART!"
          End If
    Next
  
  
End Sub

Best regards,

 

Xiaodong Liang

Developer Consultant

Autodesk Developer Technical Services