Export of active assembly BOM to Excel Template

Export of active assembly BOM to Excel Template

oleN2RXT
Participant Participant
775 Views
6 Replies
Message 1 of 7

Export of active assembly BOM to Excel Template

oleN2RXT
Participant
Participant

Hi,  Me and Chat GPT-4 had a conversation today about ilogic code to export the BOM of my open assembly. We came out on the right path until my limit was over and GPT 3.5 took over and ruined the whole thing 🙂

 

Im hoping here someone with good knowledge could help me out with a code i could run to export my BOM.

 

I would like to make my own template with headers and text, logo etc.

 

For example.

In cell A1 i want the assembly name.

Cell A2 i want todays date.

Cell A3 i want the Iproperty Title.

Row 4 will be headers for the bom. Item number, part number, quantity etc.

 

I would like the Excel template to have 5 or more sheet`s

 

In sheet 1 i want to export the Structured bom with only a few selected properties starting in Cell A5

 

Sheet 2 i want all my sheet metal parts from Parts only bom. ( so a filter needs to be applied)

 

Sheet 3 i want all parts from Parts only bom that has a custom property i have (Producttype) to have the value Phurchased.

 

Sheet 4 i want all the parts from parts only bom that has the custom property (Spare Part) set to Yes.

 

And so on with sheet 5 or more...

 

In all sheets i want to specify witch property i want to fill in.

 

And the save as the template to the same name as the assembly file and the same path as the assembly file.

 

I know it alot to ask for a complete code but i am tired of google and endless hours on silly failures. 🙂

 

Hope someone takes up on the challange. I think this would be useful for many year to come.

 

I will forever be greatful 🙂

0 Likes
776 Views
6 Replies
Replies (6)
Message 2 of 7

A.Acheson
Mentor
Mentor

Hi @oleN2RXT 

Chat GPT would not be a route to go with this. There is much too many custom elements. if you want to reduce down the amount of customization and take advantage of the existing BOM exports then this would help get you up and running quickly. But if you want to keep the custom route then you will be exporting each iproperty of the BOM individually. Luckily others have done this in previous posts so we can see how to achieve this. See this forum post here.

The code is currently exporting the "Parts Only" BOM view but if you swap the text to "Structured" then you have the BOMView source you need. 

 

Don't forget to like the post and reference where it was sourced from. 

 

As for the silly failures well that is learning and if you want help we would need to see your work and attempt to offer guidance. So post any code you worked on and others can offer there experienced advice. 

If this solved a problem, please click (accept) as solution.‌‌‌‌
Or if this helped you, please, click (like)‌‌
Regards
Alan
Message 3 of 7

oleN2RXT
Participant
Participant

Hi, I have worked on this all day. 

My template is created and i managed to fill iproperties where i want them in the different sheets.

Managed to export the bom parts only to my first sheet.

and now trying to set filter what beeing written in the rows based on a certain value in a custom property.

And struggle a bit here.

 

My complete code below..

 

Dim oDoc As AssemblyDocument
oDoc = ThisApplication.ActiveDocument

' Check if the document is an assembly
If oDoc.DocumentType <> kAssemblyDocumentObject Then
    MessageBox.Show("This rule can only be run on an assembly document.")
    Exit Sub
End If

Dim oBOM As BOM
oBOM = oDoc.ComponentDefinition.BOM

oBOM.PartsOnlyViewEnabled = True

Dim oBOMView As BOMView
oBOMView = oBOM.BOMViews.Item("Parts Only")

xlApp = CreateObject("Excel.Application")

'comment out or change to false 
'in order to not show Excel
xlApp.Visible = True 
xlWorkbook = xlApp.Workbooks.Open("W:\Bom export template2.xlsx")

xlWorksheet = xlWorkbook.Worksheets.Item("Parts Only")
xlWorksheet2 = xlWorkbook.Worksheets.Item("Profiles")
xlWorksheet3 = xlWorkbook.Worksheets.Item("Sheet Metal Parts")
xlWorksheet4 = xlWorkbook.Worksheets.Item("Purchased Parts")
xlWorksheet5 = xlWorkbook.Worksheets.Item("Spare Parts")
xlWorksheet6 = xlWorkbook.Worksheets.Item("Bolts and nuts")

Dim row As Integer
row = 8

xlWorksheet.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet.Range("I5").Value = Today()
xlWorksheet.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet2.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet2.Range("I5").Value = Today()
xlWorksheet2.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet2.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet3.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet3.Range("I5").Value = Today()
xlWorksheet3.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet3.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet4.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet4.Range("I5").Value = Today()
xlWorksheet4.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet4.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet5.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet5.Range("I5").Value = Today()
xlWorksheet5.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet5.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet6.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet6.Range("I5").Value = Today()
xlWorksheet6.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet6.Range("I4").Value = iProperties.Value("Project", "Revision number")


'Dim bRow As bomRow
bRows = oBOMView.BOMRows
For Each bRow In bRows
	
	
	Dim rDoc As Document
	rDoc = bRow.ComponentDefinitions.Item(1).Document
	
	Dim docPropertySet As PropertySet
	docPropertySet = rDoc.PropertySets.Item("Design Tracking Properties")
	
	Dim docCustomPropertySet As PropertySet
	docCustomPropertySet = rDoc.PropertySets.Item("Inventor User Defined Properties")
	
	Dim docSummaryPropertySet As PropertySet
	docSummaryPropertySet = rDoc.PropertySets.Item("Inventor Summary Information")

	If iProperties.Value("Custom", "ProductType") = "Lasercut" Then

	'xlWorksheet.Range("A" & row).Value = docSummaryPropertySet.Item("Thumbnail").Value
	xlWorksheet.Range("B" & row).Value = bRow.ItemNumber
	xlWorksheet.Range("C" & row).Value = docPropertySet.Item("Part Number").Value
	xlWorksheet.Range("D" & row).Value = bRow.ItemQuantity
	'xlWorksheet.Range("E" & row).Value = bRow.ItemUnit
	xlWorksheet.Range("F" & row).Value = docPropertySet.Item("Description").Value
	xlWorksheet.Range("G" & row).Value = docSummaryPropertySet.Item("Title").Value
	xlWorksheet.Range("H" & row).Value = docPropertySet.Item("Vendor").Value
	xlWorksheet.Range("I" & row).Value = docPropertySet.Item("Stock Number").Value
	xlWorksheet.Range("J" & row).Value = docCustomPropertySet.Item("ProductType").Value
	
	' Need here to look at Product Type to ignore if value is blank.

	row = row + 1
		
	
End If

Next

xlWorkbook.SaveAs(Filename:="W:\test1.xlsx")
xlWorkbook.Close (False)
xlApp.Quit


What i want is to only fill in the rows if the Custom property Product Type is "Lasercut"

	If iProperties.Value("Custom", "ProductType") = "Lasercut" Then

	'xlWorksheet.Range("A" & row).Value = docSummaryPropertySet.Item("Thumbnail").Value
	xlWorksheet.Range("B" & row).Value = bRow.ItemNumber
	xlWorksheet.Range("C" & row).Value = docPropertySet.Item("Part Number").Value
	xlWorksheet.Range("D" & row).Value = bRow.ItemQuantity
	'xlWorksheet.Range("E" & row).Value = bRow.ItemUnit
	xlWorksheet.Range("F" & row).Value = docPropertySet.Item("Description").Value
	xlWorksheet.Range("G" & row).Value = docSummaryPropertySet.Item("Title").Value
	xlWorksheet.Range("H" & row).Value = docPropertySet.Item("Vendor").Value
	xlWorksheet.Range("I" & row).Value = docPropertySet.Item("Stock Number").Value
	xlWorksheet.Range("J" & row).Value = docCustomPropertySet.Item("ProductType").Value
	
	' Need here to look at Product Type to ignore if value is blank.
0 Likes
Message 4 of 7

oleN2RXT
Participant
Participant

I also struggle to find any information on how to get the thumbnails in the Column A and the Unit in Column E.

 

And i get some sort of an error if Product Type value is blank

0 Likes
Message 5 of 7

A.Acheson
Mentor
Mentor

So there are a few ways to check if the ProductType property exists firstly, is not blank secondly or contains a given value etc.

 

PropertyExists:

1. You could pre filter the componentdefinitions to ensure only definitions with this iproperty are accessed so for example checking sheetmetal only definitions.

Syntax

ComponentDefinition.Type() As ObjectTypeEnum

 

If bRow.ComponentDefinitions.Item(1).Type= ObjectTypeEnum.kSheetMetalComponentDefinitionObject Then

End If

 

2. Place a try catch error trap around the get value line and this will allow an error to occur without stopping the code. 

 

Try
xlWorksheet
.Range("J" & row).Value = docCustomPropertySet.Item("ProductType").Value
Catch
End Try

 Thumbnail:

Your second question on thumbnail is a far more complicated one so hopefully others can help out with that. Your trying to copy an image to an excel sheet which is a complicated item.

 

BOMRow properties

See this help page for list of properties that exist under the BOMRow object.

And for units I believe you need the BOMQuanity object shown here

Look to the bottom of the page to see how to access the object. 

If this solved a problem, please click (accept) as solution.‌‌‌‌
Or if this helped you, please, click (like)‌‌
Regards
Alan
0 Likes
Message 6 of 7

oleN2RXT
Participant
Participant

Thanks for the reply. 

So far my code is working. Fills inn the sheet as i want and filter out some sheet based on property value.

 

Still the thumbnail to figure out and the item unit.

 

 

Dim oDoc As AssemblyDocument
oDoc = ThisApplication.ActiveDocument

' Check if the document is an assembly
If oDoc.DocumentType <> kAssemblyDocumentObject Then
    MessageBox.Show("This rule can only be run on an assembly document.")
    Exit Sub
End If

Dim oBOM As BOM
oBOM = oDoc.ComponentDefinition.BOM

oBOM.PartsOnlyViewEnabled = True

Dim sBOM As BOM
sBOM = oDoc.ComponentDefinition.BOM

sBOM.StructuredViewFirstLevelOnly = False
sBOM.StructuredViewDelimiter = "-"
sBOM.StructuredViewEnabled = True

Dim oBOMView As BOMView
oBOMView = oBOM.BOMViews.Item("Parts Only")

Dim sBOMView As BOMView
sBOMView = sBOM.BOMViews.Item("Structured")

xlApp = CreateObject("Excel.Application")

'comment out or change to false 
'in order to not show Excel
xlApp.Visible = True 
xlWorkbook = xlApp.Workbooks.Open("W:\Bom export template2.xlsx")

xlWorksheet0 = xlWorkbook.Worksheets.Item("BOM")
xlWorksheet1 = xlWorkbook.Worksheets.Item("Parts Only")
xlWorksheet2 = xlWorkbook.Worksheets.Item("Profiles")
xlWorksheet3 = xlWorkbook.Worksheets.Item("Sheet Metal Parts")
xlWorksheet4 = xlWorkbook.Worksheets.Item("Purchased Parts")
xlWorksheet5 = xlWorkbook.Worksheets.Item("Spare Parts")
xlWorksheet6 = xlWorkbook.Worksheets.Item("Bolts and nuts")
xlWorksheet7 = xlWorkbook.Worksheets.Item("CNC & 3D Print")

Dim row As Integer = 8
Dim row2 As Integer = 8 ' For sheet 2
Dim row3 As Integer = 8 ' For sheet 3
Dim row4 As Integer = 8 ' For sheet 4
Dim row5 As Integer = 8 ' For sheet 5
Dim row6 As Integer = 8 ' For sheet 6
Dim row7 As Integer = 8 ' For sheet 7
Dim row8 As Integer = 8 ' For sheet 8

xlWorksheet0.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet0.Range("I5").Value = Today()
xlWorksheet0.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet0.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet1.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet1.Range("I5").Value = Today()
xlWorksheet1.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet1.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet2.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet2.Range("I5").Value = Today()
xlWorksheet2.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet2.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet3.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet3.Range("I5").Value = Today()
xlWorksheet3.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet3.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet4.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet4.Range("I5").Value = Today()
xlWorksheet4.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet4.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet5.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet5.Range("I5").Value = Today()
xlWorksheet5.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet5.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet6.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet6.Range("I5").Value = Today()
xlWorksheet6.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet6.Range("I4").Value = iProperties.Value("Project", "Revision number")

xlWorksheet7.Range("I3").Value = iProperties.Value("Project", "Part Number")
xlWorksheet7.Range("I5").Value = Today()
xlWorksheet7.Range("E4").Value = iProperties.Value("Project", "Description")
xlWorksheet7.Range("I4").Value = iProperties.Value("Project", "Revision number")

'Write to Sheet 1 "BOM"

'Dim bRow As bomRow
bRows = sBOMView.BOMRows
For Each bRow In bRows
	
	
	Dim rDoc As Document
	rDoc = bRow.ComponentDefinitions.Item(1).Document
	
	Dim docPropertySet As PropertySet
	docPropertySet = rDoc.PropertySets.Item("Design Tracking Properties")
	
	Dim docCustomPropertySet As PropertySet
	docCustomPropertySet = rDoc.PropertySets.Item("Inventor User Defined Properties")
	
	Dim docSummaryPropertySet As PropertySet
	docSummaryPropertySet = rDoc.PropertySets.Item("Inventor Summary Information")

	
	'xlWorksheet0.Range("A" & row).Value = docSummaryPropertySet.Item("Thumbnail").Value
	xlWorksheet0.Range("B" & row).Value = bRow.ItemNumber
	xlWorksheet0.Range("C" & row).Value = docPropertySet.Item("Part Number").Value
	xlWorksheet0.Range("D" & row).Value = bRow.ItemQuantity
	'xlWorksheet0.Range("E" & row).Value = bRow.ItemUnit
	xlWorksheet0.Range("F" & row).Value = docPropertySet.Item("Description").Value
	xlWorksheet0.Range("G" & row).Value = docSummaryPropertySet.Item("Title").Value
	xlWorksheet0.Range("H" & row).Value = docPropertySet.Item("Vendor").Value
	xlWorksheet0.Range("I" & row).Value = docPropertySet.Item("Stock Number").Value
	xlWorksheet0.Range("J" & row).Value = docCustomPropertySet.Item("ProductType").Value
	' Need here to look at Product Type to ignore if value is blank.

	row = row + 1
		

Next

'Write to Sheet 2 (Parts Only)

'Dim bRow As bomRow
bRows = oBOMView.BOMRows
For Each bRow In bRows
	
	
	Dim rDoc As Document
	rDoc = bRow.ComponentDefinitions.Item(1).Document
	
	Dim docPropertySet As PropertySet
	docPropertySet = rDoc.PropertySets.Item("Design Tracking Properties")
	
	Dim docCustomPropertySet As PropertySet
	docCustomPropertySet = rDoc.PropertySets.Item("Inventor User Defined Properties")
	
	Dim docSummaryPropertySet As PropertySet
	docSummaryPropertySet = rDoc.PropertySets.Item("Inventor Summary Information")

	
	'xlWorksheet1.Range("A" & row2).Value = docSummaryPropertySet.Item("Thumbnail").Value
	xlWorksheet1.Range("B" & row2).Value = bRow.ItemNumber
	xlWorksheet1.Range("C" & row2).Value = docPropertySet.Item("Part Number").Value
	xlWorksheet1.Range("D" & row2).Value = bRow.ItemQuantity
	'xlWorksheet.Range("E" & row2).Value = bRow.ItemUnit
	xlWorksheet1.Range("F" & row2).Value = docPropertySet.Item("Description").Value
	xlWorksheet1.Range("G" & row2).Value = docSummaryPropertySet.Item("Title").Value
	xlWorksheet1.Range("H" & row2).Value = docPropertySet.Item("Vendor").Value
	xlWorksheet1.Range("I" & row2).Value = docPropertySet.Item("Stock Number").Value
	xlWorksheet1.Range("J" & row2).Value = docCustomPropertySet.Item("ProductType").Value
	' Need here to look at Product Type to ignore if value is blank.

	row2 = row2 + 1
		

Next

'Write to sheet 3 (Profiles)

'Dim bRow As bomRow
bRows = oBOMView.BOMRows
For Each bRow In bRows

	Dim rDoc As Document
	rDoc = bRow.ComponentDefinitions.Item(1).Document
	
	Dim docPropertySet As PropertySet
	docPropertySet = rDoc.PropertySets.Item("Design Tracking Properties")
	
	Dim docCustomPropertySet As PropertySet
	docCustomPropertySet = rDoc.PropertySets.Item("Inventor User Defined Properties")
	
	Dim docSummaryPropertySet As PropertySet
	docSummaryPropertySet = rDoc.PropertySets.Item("Inventor Summary Information")

	
	Dim productType As String
        Try
            productType = docCustomPropertySet.Item("ProductType").Value
        Catch ex As Exception
            productType = ""
        End Try

        ' Check if the product type is "Profile"
        If productType = "Profile"  Then

	'xlWorksheet2.Range("A" & row3).Value = docSummaryPropertySet.Item("Thumbnail").Value
	xlWorksheet2.Range("B" & row3).Value = bRow.ItemNumber
	xlWorksheet2.Range("C" & row3).Value = docPropertySet.Item("Part Number").Value
	xlWorksheet2.Range("D" & row3).Value = bRow.ItemQuantity
	xlWorksheet2.Range("E" & row3).Value = docCustomPropertySet.Item("ct_qty").Value
	'xlWorksheet2.Range("F" & row3).Value = docCustomPropertySet.Item("CUTDETAIL1").Value
	'xlWorksheet2.Range("G" & row3).Value = docCustomPropertySet.Item("CUTDETAIL2").Value
	xlWorksheet2.Range("H" & row3).Value = docPropertySet.Item("Stock Number").Value
	xlWorksheet2.Range("I" & row3).Value = docPropertySet.Item("Description").Value
	xlWorksheet2.Range("J" & row3).Value = docSummaryPropertySet.Item("Title").Value
	
	row3 = row3 + 1
		
	
        End If
Next

'Write to sheet 4 (Sheet Metal Parts)

'Dim bRow As bomRow
bRows = oBOMView.BOMRows
For Each bRow In bRows

	Dim rDoc As Document
	rDoc = bRow.ComponentDefinitions.Item(1).Document
	
	Dim docPropertySet As PropertySet
	docPropertySet = rDoc.PropertySets.Item("Design Tracking Properties")
	
	Dim docCustomPropertySet As PropertySet
	docCustomPropertySet = rDoc.PropertySets.Item("Inventor User Defined Properties")
	
	Dim docSummaryPropertySet As PropertySet
	docSummaryPropertySet = rDoc.PropertySets.Item("Inventor Summary Information")

	
	Dim productType As String
        Try
            productType = docCustomPropertySet.Item("ProductType").Value
        Catch ex As Exception
            productType = ""
        End Try

        ' Check if the product type is "Lasercut"
        If productType = "Lasercut" Or productType = "Lasercut & Reshape" Then

	'xlWorksheet3.Range("A" & row4).Value = docSummaryPropertySet.Item("Thumbnail").Value
	xlWorksheet3.Range("B" & row4).Value = bRow.ItemNumber
	xlWorksheet3.Range("C" & row4).Value = docPropertySet.Item("Part Number").Value
	xlWorksheet3.Range("D" & row4).Value = bRow.ItemQuantity
	'xlWorksheet3.Range("E" & row4).Value = bRow.ItemUnit
	xlWorksheet3.Range("F" & row4).Value = docPropertySet.Item("Description").Value
	xlWorksheet3.Range("G" & row4).Value = docSummaryPropertySet.Item("Title").Value
	xlWorksheet3.Range("H" & row4).Value = docCustomPropertySet.Item("Thickness").Value
	xlWorksheet3.Range("I" & row4).Value = docPropertySet.Item("Stock Number").Value
	xlWorksheet3.Range("J" & row4).Value = docCustomPropertySet.Item("ProductType").Value
	' Need here to look at Product Type to ignore if value is blank.

	row4 = row4 + 1
		
	
        End If
Next


'Write to sheet 5 (Phurchased parts)

'Dim bRow As bomRow
bRows = oBOMView.BOMRows
For Each bRow In bRows

	Dim rDoc As Document
	rDoc = bRow.ComponentDefinitions.Item(1).Document
	
	Dim docPropertySet As PropertySet
	docPropertySet = rDoc.PropertySets.Item("Design Tracking Properties")
	
	Dim docCustomPropertySet As PropertySet
	docCustomPropertySet = rDoc.PropertySets.Item("Inventor User Defined Properties")
	
	Dim docSummaryPropertySet As PropertySet
	docSummaryPropertySet = rDoc.PropertySets.Item("Inventor Summary Information")

	
	Dim productType As String
	Dim Vendor As String
        Try
            productType = docCustomPropertySet.Item("ProductType").Value
        Catch ex As Exception
            productType = ""
        End Try
		
		Try
            Vendor = docPropertySet.Item("Vendor").Value
        Catch ex As Exception
            Vendor = ""
        End Try

        ' Check if the product type is "Purchased" and not Vendor Festemateriell
        If productType = "Purchased" And Vendor <> "Festemateriell" Then  
			
    xlWorksheet4.Range("H" & row5).Value = docPropertySet.Item("Vendor").Value
	'xlWorksheet4.Range("A" & row5).Value = docSummaryPropertySet.Item("Thumbnail").Value
	xlWorksheet4.Range("B" & row5).Value = bRow.ItemNumber
	xlWorksheet4.Range("C" & row5).Value = docPropertySet.Item("Part Number").Value
	xlWorksheet4.Range("D" & row5).Value = bRow.ItemQuantity
	'xlWorksheet4.Range("E" & row5).Value = bRow.ItemUnit
	xlWorksheet4.Range("F" & row5).Value = docPropertySet.Item("Description").Value
	xlWorksheet4.Range("G" & row5).Value = docSummaryPropertySet.Item("Title").Value
	
	xlWorksheet4.Range("I" & row5).Value = docPropertySet.Item("Stock Number").Value
	xlWorksheet4.Range("J" & row5).Value = docCustomPropertySet.Item("ProductType").Value
	' Need here to look at Product Type to ignore if value is blank.

	row5 = row5 + 1
		
	
        End If
Next

'Write to sheet 6 (Spare Part)

'Dim bRow As bomRow
bRows = oBOMView.BOMRows
For Each bRow In bRows

	Dim rDoc As Document
	rDoc = bRow.ComponentDefinitions.Item(1).Document
	
	Dim docPropertySet As PropertySet
	docPropertySet = rDoc.PropertySets.Item("Design Tracking Properties")
	
	Dim docCustomPropertySet As PropertySet
	docCustomPropertySet = rDoc.PropertySets.Item("Inventor User Defined Properties")
	
	Dim docSummaryPropertySet As PropertySet
	docSummaryPropertySet = rDoc.PropertySets.Item("Inventor Summary Information")

	
	Dim Sparepart As String
        Try
            Sparepart = docCustomPropertySet.Item("Spare Part").Value
        Catch ex As Exception
            Sparepart = ""
        End Try

        ' Check if the Spare Part is "YES"
        If Sparepart = "YES"  Then

	'xlWorksheet5.Range("A" & row6).Value = docSummaryPropertySet.Item("Thumbnail").Value
	xlWorksheet5.Range("B" & row6).Value = docCustomPropertySet.Item("GJ Artikkel Nr").Value
	xlWorksheet5.Range("C" & row6).Value = docPropertySet.Item("Part Number").Value
	xlWorksheet5.Range("D" & row6).Value = bRow.ItemQuantity
	'xlWorksheet5.Range("E" & row6).Value = bRow.ItemUnit
	xlWorksheet5.Range("F" & row6).Value = docPropertySet.Item("Description").Value
	xlWorksheet5.Range("G" & row6).Value = docCustomPropertySet.Item("Spare Part").Value
	xlWorksheet5.Range("H" & row6).Value = docCustomPropertySet.Item("Part Class").Value
	xlWorksheet5.Range("I" & row6).Value = docCustomPropertySet.Item("ProductType").Value
	' Need here to look at Product Type to ignore if value is blank.

	row6 = row6 + 1
		
	
        End If
Next

' Save the Excel file with the same name and path as the assembly document
Dim asmFilePath As String = oDoc.FullFileName
Dim asmFileName As String = System.IO.Path.GetFileNameWithoutExtension(asmFilePath)
Dim excelFilePath As String = System.IO.Path.Combine(System.IO.Path.GetDirectoryName(asmFilePath), asmFileName & ".xlsx")

xlWorkbook.SaveAs(Filename :=excelFilePath)
'Keep Excel open
XlApp.Visible = True
0 Likes
Message 7 of 7

A.Acheson
Mentor
Mentor

Here is one forum post wirha  method to get the image. Effectively it creates an image using the camera. Not exactly using the thumbnail but it might work for you. 

 

And here is another using the thumbnail. It is in VBA so will need to be converted to VB.NET which can be a challenge. 

 

If this solved a problem, please click (accept) as solution.‌‌‌‌
Or if this helped you, please, click (like)‌‌
Regards
Alan
0 Likes