Community

Export BOM to Excel VBA

Export BOM to Excel VBA

J.Classens
Enthusiast Enthusiast
1,406 Views
6 Replies
Message 1 of 7

Export BOM to Excel VBA

J.Classens
Enthusiast
Enthusiast
‎08-16-2021 11:22 PM

Hello, 

 

I have found an export BOM VBA rule.

Afterward I have customized it to work for my purpose. 

 

Public Sub BOM_Export()
    ' Set a reference to the assembly document.
    ' This assumes an assembly document is active.
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument

    Dim oTemplate As String: oTemplate = "I:\Engineering\Formulieren en lijsten\Spare & wear parts lijst\Spare_wear_parts_Engels_Nieuw artikelnummersysteem.xltx"
  
    ' Set a reference to the BOM
    Dim oBOM As BOM
    Set oBOM = oDoc.ComponentDefinition.BOM
    
    ' Set whether first level only or all levels.
    oBOM.StructuredViewFirstLevelOnly = False
    
    ' Make sure that the structured view is enabled.
    oBOM.StructuredViewEnabled = True
    
    'Set a reference to the "Structured" BOMView
    Dim oBOMView As BOMView
    Set oBOMView = ThisApplication.ActiveDocument.ComponentDefinition.BOM.BOMViews.Item("Structured")
    
   ' Dim oBOMView As BOMView
    Set oBOMView = oBOM.BOMViews.Item("Structured")
    
    
    Dim oPartNumProperty As String
    oPartNumProperty = oDoc.ComponentDefinition.Document.PropertySets( _
        "Design Tracking Properties")("Part Number").Value
    
   
    Dim oPartRevNum As String
    oPartRevNum = oDoc.ComponentDefinition.Document.PropertySets( _
        "Inventor Summary Information")("Revision Number").Value
        
    Dim oPartTitle As String
    oPartTitle = oDoc.ComponentDefinition.Document.PropertySets( _
        "Inventor Summary Information")("Title").Value
        
    Call oBOMView.Sort("Item", True)
    
    ' set excel app and add worksheet
    Dim xlApp As Object
    Dim xlwb As Object
    Dim xlws As Object
    Set xlApp = CreateObject("Excel.Application")
    Set xlwb = xlApp.Workbooks.Open(oTemplate)
    'Set xlwb = xlApp.workbooks.Add
    Set xlws = xlwb.Worksheets(1)
    xlApp.Visible = True

    ' write more stuff
    ' xlws.Cells(1, 2) = oPartTitle
    ' xlws.Cells(1, 3) = oPartNumProperty
    ' xlws.Cells(1, 4) = "Rev: " & oPartRevNum
    xlws.Name = "Export list " & oPartNumProperty

    'Initialize the tab for ItemNumber
    Dim ItemTab As Long
    ItemTab = -3

    Dim oStartRow As Integer: oStartRow = 2
    
    Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab, xlApp, xlwb, xlws, oStartRow)
End Sub

Private Sub QueryBOMRowProperties(oBOMRows As BOMRowsEnumerator, ItemTab As Long, ByVal xlApp As Object, ByVal xlwb As Object, ByVal xlws As Object, oStartRow As Integer)
    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 oPartTitle As Property
        Dim oPartDescription As Property
        Dim oPartMaterial As Property
        Dim oPartVendor As Property
        Dim oPartStatus As Property
        Dim oPartArticleNo As Property
        Dim oPartSurface As Property
        Dim oPartSurfaceValue As Property
        Dim oPartSpare As Property
        Dim oPartWeld As Property
    

        If TypeOf oCompDef Is VirtualComponentDefinition Then
        
            Set oPartNumProperty = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Part Number")
                
            Set oPartTitle = oCompDef.Document.PropertySets _
                .Item("Inventor Summary Information").Item("Title")
                
            Set oPartDescription = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Description")
                
            Set oPartMaterial = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Material")
                
            Set oPartVendor = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Vendor")
                
            Set oPartStatus = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("User Status")
                
            On Error Resume Next
            Set oPartArticleNo = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Article No")
            
            On Error Resume Next
            Set oPartSurface = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment")
            
            On Error Resume Next
            Set oPartSurfaceValue = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment Value")

            On Error Resume Next
            Set oPartSpare = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("SpareWear")
                
            On Error Resume Next
            Set oPartWeld = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Weld Assembly")

                    
                xlws.Cells(oStartRow + b, 1) = oRow.ItemNumber
                xlws.Cells(oStartRow + b, 2) = oPartNumProperty.Value
                xlws.Cells(oStartRow + b, 3) = oRow.ItemQuantity
                xlws.Cells(oStartRow + b, 4) = oPartArticleNo.Value
                xlws.Cells(oStartRow + b, 5) = oPartTitle.Value
                xlws.Cells(oStartRow + b, 6) = oPartDescription.Value
                xlws.Cells(oStartRow + b, 7) = oPartMaterial.Value
                xlws.Cells(oStartRow + b, 😎 = oPartSurface.Value
                xlws.Cells(oStartRow + b, 9) = oPartSurfaceValue.Value
                xlws.Cells(oStartRow + b, 10) = oPartVendor.Value
                xlws.Cells(oStartRow + b, 11) = oPartSpare.Value
                xlws.Cells(oStartRow + b, 12) = oPartStatus.Value
                xlws.Cells(oStartRow + b, 13) = oPartWeld.Value
   
             
             
        oStartRow = oStartRow + 1
        
 
        Else
            'Get the file property that contains the "Part Number"
            'The file property is obtained from the parent
            'document of the associated ComponentDefinition.
                 ' write more stuff

            Set oPartNumProperty = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Part Number")
                
            Set oPartTitle = oCompDef.Document.PropertySets _
                .Item("Inventor Summary Information").Item("Title")
                
            Set oPartDescription = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Description")
                                            
            Set oPartMaterial = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Material")
                
            Set oPartVendor = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Vendor")
                
            Set oPartStatus = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("User Status")
                
            On Error Resume Next
            Set oPartArticleNo = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Article No")
            
            On Error Resume Next
            Set oPartSurface = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment")
            
            On Error Resume Next
            Set oPartSurfaceValue = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment Value")

            On Error Resume Next
            Set oPartSpare = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("SpareWear")
                
            On Error Resume Next
            Set oPartWeld = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Weld Assembly")
                
                xlws.Cells(oStartRow + b, 1) = oRow.ItemNumber
                xlws.Cells(oStartRow + b, 2) = oPartNumProperty.Value
                xlws.Cells(oStartRow + b, 3) = oRow.ItemQuantity
                xlws.Cells(oStartRow + b, 4) = oPartArticleNo.Value
                xlws.Cells(oStartRow + b, 5) = oPartTitle.Value
                xlws.Cells(oStartRow + b, 6) = oPartDescription.Value
                xlws.Cells(oStartRow + b, 7) = oPartMaterial.Value
                xlws.Cells(oStartRow + b, 😎 = oPartSurface.Value
                xlws.Cells(oStartRow + b, 9) = oPartSurfaceValue.Value
                xlws.Cells(oStartRow + b, 10) = oPartVendor.Value
                xlws.Cells(oStartRow + b, 11) = oPartSpare.Value
                xlws.Cells(oStartRow + b, 12) = oPartStatus.Value
                xlws.Cells(oStartRow + b, 13) = oPartWeld.Value
                
                         
              oStartRow = oStartRow + 1
              
        
            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, xlApp, xlwb, xlws, oStartRow)
            End If
        End If
    Next
    ItemTab = ItemTab - 3
End Sub

 

The rule works but there are two problem I couldn't fix. 

 

Problem 1:

 Call oBOMView.Sort("Item", True)

This part should sort the BOM list according to Item number.

The output isn't sorted.

JClassens_0-1629180505240.png

Any ideas why this isn't working?

 

Problem 2:

The property oPartArticleNo doesn't reset so it pops up in mutple lines.

I have tried to do a set after the export  Set oPartArticleNo = "" this isn't working.

 

JClassens_1-1629180862334.png

 

How should it be?

 

JClassens_2-1629181141108.png

 

 

 

0 Likes
Like
Report
1,407 Views
6 Replies
Replies (6)
Message 2 of 7

WCrihfield
Mentor
Mentor
‎08-17-2021 07:01 AM

Not sure why the Sort() method doesn't appear to be working correctly for you, but have you tried using the Sort2() method, then use the last input variable (SortByString) to use different sorting method to see if that works any better?  We can't see column titles in your posted images, so are you sure the column title you are specifying is exactly the same as what is being used in the BOM?  I'm not sure what you mean by "oPartArticleNo doesn't reset", so I don't have any advise there.

Wesley Crihfield

EESignature

(Not an Autodesk Employee)

0 Likes
Like
Report
Message 3 of 7

WCrihfield
Mentor
Mentor
‎08-17-2021 08:09 AM

I did notice that you seem to be using the phrase "On Error Resume Next" an excessive amount of times.  Generally, you only need to use that once within the level of code that it is located.  It's like a light switch or mode, once you turn it on within that level of the routine, it stays on at that level until it exits that level or routine.  If any of those values are important, you could include some code to either check the value or check if there was an Err (error) right afterwords, then if you want to disable that 'On Error Resume Next' mode, just use 'On Error GoTo 0'.  This doesn't send it to the beginning of the code, just disables that existing error handling mode, back to normal.  Here is a link on VBA error handling.

Wesley Crihfield

EESignature

(Not an Autodesk Employee)

0 Likes
Like
Report
Message 4 of 7

J.Classens
Enthusiast
Enthusiast
in reply to WCrihfield
‎08-17-2021 11:43 AM

@WCrihfield 

Thanks for the links! 

They are helpfull.

 

I have changed the code.

Public Sub BOM_Export()
    ' Set a reference to the assembly document.
    ' This assumes an assembly document is active.
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument

    Dim oTemplate As String: oTemplate = "I:\Engineering\Formulieren en lijsten\Spare & wear parts lijst\Spare_wear_parts_Engels_Nieuw artikelnummersysteem.xltx"
  
    ' Set a reference to the BOM
    Dim oBOM As BOM
    Set oBOM = oDoc.ComponentDefinition.BOM
    
    ' Set whether first level only or all levels.
    oBOM.StructuredViewFirstLevelOnly = False
    
    ' Make sure that the structured view is enabled.
    oBOM.StructuredViewEnabled = True
    
    'Set a reference to the "Structured" BOMView
    Dim oBOMView As BOMView
    Set oBOMView = ThisApplication.ActiveDocument.ComponentDefinition.BOM.BOMViews.Item("Structured")
    
   ' Dim oBOMView As BOMView
   Set oBOMView = oBOM.BOMViews.Item("Structured")
    
    
    Dim oPartNumProperty As String
    oPartNumProperty = oDoc.ComponentDefinition.Document.PropertySets( _
        "Design Tracking Properties")("Part Number").Value
    
   
    Dim oPartRevNum As String
    oPartRevNum = oDoc.ComponentDefinition.Document.PropertySets( _
        "Inventor Summary Information")("Revision Number").Value
        
    Dim oPartTitle As String
    oPartTitle = oDoc.ComponentDefinition.Document.PropertySets( _
        "Inventor Summary Information")("Title").Value
        
    Call oBOMView.Sort2("Item", SortByString)
    
    ' set excel app and add worksheet
    Dim xlApp As Object
    Dim xlwb As Object
    Dim xlws As Object
    Set xlApp = CreateObject("Excel.Application")
    Set xlwb = xlApp.Workbooks.Open(oTemplate)
    'Set xlwb = xlApp.workbooks.Add
    Set xlws = xlwb.Worksheets(1)
    xlApp.Visible = True

    ' write more stuff
    ' xlws.Cells(1, 2) = oPartTitle
    ' xlws.Cells(1, 3) = oPartNumProperty
    ' xlws.Cells(1, 4) = "Rev: " & oPartRevNum
    xlws.Name = "Export list " & oPartNumProperty

    'Initialize the tab for ItemNumber
    Dim ItemTab As Long
    ItemTab = -3

    Dim oStartRow As Integer: oStartRow = 2
    
    Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab, xlApp, xlwb, xlws, oStartRow)
End Sub

Private Sub QueryBOMRowProperties(oBOMRows As BOMRowsEnumerator, ItemTab As Long, ByVal xlApp As Object, ByVal xlwb As Object, ByVal xlws As Object, oStartRow As Integer)
    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 oPartTitle As Property
        Dim oPartDescription As Property
        Dim oPartMaterial As Property
        Dim oPartVendor As Property
        Dim oPartStatus As Property
        Dim oPartArticleNo As Property
        Dim oPartSurface As Property
        Dim oPartSurfaceValue As Property
        Dim oPartSpare As Property
        Dim oPartWeld As Property
    
        If TypeOf oCompDef Is VirtualComponentDefinition Then
        
            Set oPartNumProperty = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Part Number")
                
            Set oPartTitle = oCompDef.Document.PropertySets _
                .Item("Inventor Summary Information").Item("Title")
                
            Set oPartDescription = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Description")
                
            Set oPartMaterial = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Material")
                
            Set oPartVendor = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Vendor")
                
            Set oPartStatus = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("User Status")
                
            On Error Resume Next
            Set oPartArticleNo = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Article No")
                        
            Set oPartSurface = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment")
                       
            Set oPartSurfaceValue = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment Value")
           
            Set oPartSpare = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("SpareWear")
          
            Set oPartWeld = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Weld Assembly")
                    
                xlws.Cells(oStartRow + b, 1) = oRow.ItemNumber
                xlws.Cells(oStartRow + b, 2) = oPartNumProperty.Value
                xlws.Cells(oStartRow + b, 3) = oRow.ItemQuantity
                xlws.Cells(oStartRow + b, 4) = oPartArticleNo.Value
                xlws.Cells(oStartRow + b, 5) = oPartTitle.Value
                xlws.Cells(oStartRow + b, 6) = oPartDescription.Value
                xlws.Cells(oStartRow + b, 7) = oPartMaterial.Value
                xlws.Cells(oStartRow + b, 😎 = oPartSurface.Value
                xlws.Cells(oStartRow + b, 9) = oPartSurfaceValue.Value
                xlws.Cells(oStartRow + b, 10) = oPartVendor.Value
                xlws.Cells(oStartRow + b, 11) = oPartSpare.Value
                xlws.Cells(oStartRow + b, 12) = oPartStatus.Value
                xlws.Cells(oStartRow + b, 13) = oPartWeld.Value
                             
        oStartRow = oStartRow + 1
        
 
        Else
            'Get the file property that contains the "Part Number"
            'The file property is obtained from the parent
            'document of the associated ComponentDefinition.
                 ' write more stuff

            Set oPartNumProperty = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Part Number")
                
            Set oPartTitle = oCompDef.Document.PropertySets _
                .Item("Inventor Summary Information").Item("Title")
                
            Set oPartDescription = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Description")
                                            
            Set oPartMaterial = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Material")
                
            Set oPartVendor = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Vendor")
                
            Set oPartStatus = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("User Status")
                
            On Error Resume Next
            Set oPartArticleNo = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Article No")
                        
            Set oPartSurface = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment")
                      
            Set oPartSurfaceValue = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment Value")

            Set oPartSpare = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("SpareWear")
            
            Set oPartWeld = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Weld Assembly")
                
                xlws.Cells(oStartRow + b, 1) = oRow.ItemNumber
                xlws.Cells(oStartRow + b, 2) = oPartNumProperty.Value
                xlws.Cells(oStartRow + b, 3) = oRow.ItemQuantity
                xlws.Cells(oStartRow + b, 4) = oPartArticleNo.Value
                xlws.Cells(oStartRow + b, 5) = oPartTitle.Value
                xlws.Cells(oStartRow + b, 6) = oPartDescription.Value
                xlws.Cells(oStartRow + b, 7) = oPartMaterial.Value
                xlws.Cells(oStartRow + b, 😎 = oPartSurface.Value
                xlws.Cells(oStartRow + b, 9) = oPartSurfaceValue.Value
                xlws.Cells(oStartRow + b, 10) = oPartVendor.Value
                xlws.Cells(oStartRow + b, 11) = oPartSpare.Value
                xlws.Cells(oStartRow + b, 12) = oPartStatus.Value
                xlws.Cells(oStartRow + b, 13) = oPartWeld.Value
                
                         
              oStartRow = oStartRow + 1
              
        
            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, xlApp, xlwb, xlws, oStartRow)
            End If
        End If
        
     Next
    ItemTab = ItemTab - 3
End Sub

 

Unfortunately the sorting isn't working.

 The BOM list looks like this:

JClassens_0-1629225018194.png

The Item column is sorted as you can see.

This is exactly the way i want it be exported to excel. 

My code produces the next list 

JClassens_1-1629225240952.png

 

any suggestion why the sorting doesn't do it the same?

 

The problem of resetting is as following. 

In column 4, 8 and 9 you can see custom properties. 

When the code want's to fill the next row in excel it should reset the memory. 

Some parts don't have these custom values and the code fills in the same value as the previous row. 

I have made these cells yellow so you can see what i meen.

JClassens_2-1629225727295.png

 

 

 

0 Likes
Like
Report
Message 5 of 7

WCrihfield
Mentor
Mentor
in reply to J.Classens
‎08-17-2021 11:58 AM

Hmm... You are creating the variables for those Properties within the loop (good), so they shouldn't be remembered from one loop to the next.  Maybe set the value of each of those variables that are to represent an iProperty to Nothing when you create them, just be extra sure.  Leaving for the day, so I hope this helps some.

Wesley Crihfield

EESignature

(Not an Autodesk Employee)

0 Likes
Like
Report
Message 6 of 7

J.Classens
Enthusiast
Enthusiast
in reply to WCrihfield
‎08-17-2021 12:14 PM

That have done the trick with the resetting .

It resets now the properties to nothing. 

 

The only challenge is the sorting 👌 

 

Have a nice day! 

 

0 Likes
Like
Report
Message 7 of 7

J.Classens
Enthusiast
Enthusiast
‎08-19-2021 04:38 AM

@WCrihfield 

I have tried some tricks but the sorting still doesn't work. 

It seems to not sort at all. should do the sorting like in the BOM list.

JClassens_1-1629372751134.png

It provides the next excel sheet.

 

JClassens_0-1629372620927.png

 

This is the code I'm using now. 

Public Sub BOM_Export()
    ' Set a reference to the assembly document.
    ' This assumes an assembly document is active.
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument

    Dim oTemplate As String: oTemplate = "I:\Engineering\Formulieren en lijsten\Spare & wear parts lijst\MAXXXXXX-MAA.0000XXXXX-ORDERNO_YYYYMMDD.xltx"
  
    ' Set a reference to the BOM
    Dim oBOM As BOM
    Set oBOM = oDoc.ComponentDefinition.BOM
    
    ' Set whether first level only or all levels.
    oBOM.StructuredViewFirstLevelOnly = False
    
    ' Make sure that the structured view is enabled.
    oBOM.StructuredViewEnabled = True
    
    'Set a reference to the "Structured" BOMView
    Dim oBOMView As BOMView
    Set oBOMView = ThisApplication.ActiveDocument.ComponentDefinition.BOM.BOMViews.Item("Structured")
    
   ' Dim oBOMView As BOMView
   Set oBOMView = oBOM.BOMViews.Item("Structured")
   
   Call oBOMView.Sort("Item", True)
   
        
    Dim oPartNumProperty As String
    oPartNumProperty = oDoc.ComponentDefinition.Document.PropertySets( _
        "Design Tracking Properties")("Part Number").Value
    
   
    Dim oPartRevNum As String
    oPartRevNum = oDoc.ComponentDefinition.Document.PropertySets( _
        "Inventor Summary Information")("Revision Number").Value
        
    Dim oPartTitle As String
    oPartTitle = oDoc.ComponentDefinition.Document.PropertySets( _
        "Inventor Summary Information")("Title").Value
        
    
    
    ' set excel app and add worksheet
    Dim xlApp As Object
    Dim xlwb As Object
    Dim xlws As Object
    Set xlApp = CreateObject("Excel.Application")
    Set xlwb = xlApp.Workbooks.Open(oTemplate)
    'Set xlwb = xlApp.workbooks.Add
    Set xlws = xlwb.Worksheets(1)
    xlApp.Visible = True

    ' write more stuff
    ' xlws.Cells(1, 2) = oPartTitle
    ' xlws.Cells(1, 3) = oPartNumProperty
    ' xlws.Cells(1, 4) = "Rev: " & oPartRevNum
    xlws.Name = "Export list " & oPartNumProperty

    'Initialize the tab for ItemNumber
    Dim ItemTab As Long
    ItemTab = -1

    Dim oStartRow As Integer: oStartRow = 2
    
    Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab, xlApp, xlwb, xlws, oStartRow)
End Sub

Private Sub QueryBOMRowProperties(oBOMRows As BOMRowsEnumerator, ItemTab As Long, ByVal xlApp As Object, ByVal xlwb As Object, ByVal xlws As Object, oStartRow As Integer)
    ItemTab = ItemTab + 1
    
    ' 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 oPartTitle As Property
        Dim oPartDescription As Property
        Dim oPartMaterial As Property
        Dim oPartVendor As Property
        Dim oPartStatus As Property
        Dim oPartFile As Property
        Dim oPartArticleNo As Property
        Dim oPartSurface As Property
        Dim oPartSurfaceValue As Property
        Dim oPartSpare As Property
        Dim oPartWeld As Property
    
        If TypeOf oCompDef Is VirtualComponentDefinition Then
        
            Set oPartNumProperty = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Part Number")
                
            Set oPartTitle = oCompDef.Document.PropertySets _
                .Item("Inventor Summary Information").Item("Title")
                
            Set oPartDescription = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Description")
                
            Set oPartMaterial = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Material")
                
            Set oPartVendor = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Vendor")
                
            Set oPartStatus = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("User Status")
            
            'Set oPartFile = oCompDef.Document.Property.Name(FileName)
                
            On Error Resume Next
            
            Set oPartArticleNo = Nothing
            
            Set oPartArticleNo = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Article No")
                
            Set oPartSurface = Nothing
                        
            Set oPartSurface = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment")
                
            Set oPartSurfaceValue = Nothing
                      
            Set oPartSurfaceValue = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment Value")
                
            Set oPartSpare = Nothing

            Set oPartSpare = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("SpareWear")
                
            Set oPartWeld = Nothing
            
            Set oPartWeld = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Weld Assembly")
                    
                xlws.Cells(oStartRow + b, 1) = oRow.ItemNumber
                xlws.Cells(oStartRow + b, 2) = oPartNumProperty.Value
                xlws.Cells(oStartRow + b, 3) = oRow.ItemQuantity
                xlws.Cells(oStartRow + b, 4) = oPartArticleNo.Value
                xlws.Cells(oStartRow + b, 5) = oPartTitle.Value
                xlws.Cells(oStartRow + b, 6) = oPartDescription.Value
                xlws.Cells(oStartRow + b, 7) = oPartMaterial.Value
                xlws.Cells(oStartRow + b, 😎 = oPartSurface.Value
                xlws.Cells(oStartRow + b, 9) = oPartSurfaceValue.Value
                xlws.Cells(oStartRow + b, 10) = oPartVendor.Value
                xlws.Cells(oStartRow + b, 11) = oPartSpare.Value
                xlws.Cells(oStartRow + b, 12) = oPartStatus.Value
                xlws.Cells(oStartRow + b, 13) = oPartWeld.Value
                xlws.Cells(oStartRow + b, 14) = oPartFile.Value
                             
        oStartRow = oStartRow + 1
        
 
        Else
            'Get the file property that contains the "Part Number"
            'The file property is obtained from the parent
            'document of the associated ComponentDefinition.
                 ' write more stuff

            Set oPartNumProperty = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Part Number")
                
            Set oPartTitle = oCompDef.Document.PropertySets _
                .Item("Inventor Summary Information").Item("Title")
                
            Set oPartDescription = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Description")
                                            
            Set oPartMaterial = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Material")
                
            Set oPartVendor = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("Vendor")
                
            Set oPartStatus = oCompDef.Document.PropertySets _
                .Item("Design Tracking Properties").Item("User Status")
                
            'Set oPartFile = oCompDef.Document.Property.Name(FileName)
                
            On Error Resume Next
            
            Set oPartArticleNo = Nothing
            
            Set oPartArticleNo = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Article No")
                
            Set oPartSurface = Nothing
                        
            Set oPartSurface = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment")
                
            Set oPartSurfaceValue = Nothing
                      
            Set oPartSurfaceValue = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Surface Treatment Value")
                
            Set oPartSpare = Nothing

            Set oPartSpare = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("SpareWear")
                
            Set oPartWeld = Nothing
            
            Set oPartWeld = oCompDef.Document.PropertySets _
                .Item("Inventor User Defined Properties").Item("Weld Assembly")
                
                xlws.Cells(oStartRow + b, 1) = oRow.ItemNumber
                xlws.Cells(oStartRow + b, 2) = oPartNumProperty.Value
                xlws.Cells(oStartRow + b, 3) = oRow.ItemQuantity
                xlws.Cells(oStartRow + b, 4) = oPartArticleNo.Value
                xlws.Cells(oStartRow + b, 5) = oPartTitle.Value
                xlws.Cells(oStartRow + b, 6) = oPartDescription.Value
                xlws.Cells(oStartRow + b, 7) = oPartMaterial.Value
                xlws.Cells(oStartRow + b, 😎 = oPartSurface.Value
                xlws.Cells(oStartRow + b, 9) = oPartSurfaceValue.Value
                xlws.Cells(oStartRow + b, 10) = oPartVendor.Value
                xlws.Cells(oStartRow + b, 11) = oPartSpare.Value
                xlws.Cells(oStartRow + b, 12) = oPartStatus.Value
                xlws.Cells(oStartRow + b, 13) = oPartWeld.Value
                xlws.Cells(oStartRow + b, 14) = oPartFile.Value
                         
              oStartRow = oStartRow + 1
              
        
            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, xlApp, xlwb, xlws, oStartRow)
            End If
        End If
        
     Next
    ItemTab = ItemTab - 1
End Sub

 

Is there something in the code that prevents the list to sort before exporting?

 

0 Likes
Like
Report
Report a website issue