Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
WCrihfield
in reply to: aurel_e

Hi @aurel_e.  Here is something you can try, or use as a starting point.  There are lots of ways of doing something like this, and lots of ways of customizing it, but right now I am still using a regular List(Of String) filled with the FullFileName's of all the sub assemblies, and sending that to a custom Sub routine, that was designed to write a List(Of String) to Excel.  I already had something like this, but for dealing with a Dictionary, instead of a List, so I just customized it a bit to add the 3 column headers, and write the data to the second column, instead of the first one.

 

Later, if you want to gather all 3 pieces of data from the assembly to send to the routine, you could create and use something like a List(Of List(Of String)) [a List of Lists of Strings] or a List(Of String()) [a List of String arrays], where the Part Number value would be the first String, then the file name would be the second String, and the Quantity could also be converted to a String as the third value.  Then just change the Type of the first input, and change the code within that Sub routine a bit to handle the new data arrangement.

AddReference "Microsoft.Office.Interop.Excel.dll"
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Excel
Sub Main
	If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then Return
	Dim oADoc As AssemblyDocument = ThisDoc.Document
	Dim oRefDocs As DocumentsEnumerator = oADoc.AllReferencedDocuments
	Dim oList As New List(Of String)
	Dim iCount As Integer = 0
	For Each oRefDoc As Inventor.Document In oRefDocs
		If oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
			If oList.Contains(oRefDoc.FullFileName) = False Then
				oList.Add(oRefDoc.FullFileName)
				iCount = iCount + 1
			End If
		End If
	Next
	MsgBox("There are " & iCount & " unique sub assemblies in this assembly.", vbInformation, "iLogic")
	'same path and file name as this assembly, but with ".xlsx" file extension
	Dim sExcelFile As String = System.IO.Path.ChangeExtension(oADoc.FullFileName, ".xlsx")
	WriteListToExcel(oList, sExcelFile)
End Sub

Sub WriteListToExcel(oList As List(Of String), Optional sExcelFileName As String = vbNullString, Optional sExcelSheetName As String = vbNullString)
	If oList Is Nothing OrElse oList.Count = 0 Then Return
	Dim oExcel As Excel.Application = GetExcel
	If oExcel Is Nothing Then Return
	oExcel.Visible = True
	oExcel.DisplayAlerts = True
	Dim oWB As Workbook = oExcel.Workbooks.Add()
	If oWB Is Nothing Then Return
	Dim oWS As Worksheet
	If oWB.Worksheets.Count = 0 Then
		oWS = oWB.Worksheets.Add()
	Else
		oWS = oWB.Worksheets.Item(1)
	End If
	If oWS Is Nothing Then Return
	'add column headers
	oWS.Range("A1").Value = "Part Number"
	oWS.Range("B1").Value = "File Name"
	oWS.Range("C1").Value = "Qty"
	Dim oRow As Integer = 1 'row just above first data row, because loop increments before writing
	For Each oEntry In oList
		oRow = oRow + 1
		'oEntry contains FullFileName (path, file name, and file extension), so we must isolate just file name
		oWS.Cells(oRow, 2) = System.IO.Path.GetFileNameWithoutExtension(oEntry)
	Next
	oWS.Columns.AutoFit
	Try
		oWB.SaveAs(sExcelFileName)
	Catch
		MsgBox("Error trying to save this Excel file as the following:" & vbCrLf & sExcelFileName, vbCritical, "iLogic")
	End Try
	oWS = Nothing
	oWB.Close(False)
	oWB = Nothing
	'oExcel.Quit 'should only quit, if a new instance of Excel was started, but we do not know that
	oExcel = Nothing
End Sub

Function GetExcel(Optional bVisible As Boolean = False) As Excel.Application
	Dim oXL As Excel.Application
	Try 'try to find an already running instance of the Excel Application
		oXL = GetObject(, "Excel.Application")
	Catch 'it wasn't found open, so create an instance of it (start the application)
		Try : oXL = CreateObject("Excel.Application") : Catch : End Try
	End Try
	If oXL IsNot Nothing Then oXL.Visible = bVisible
	Return oXL
End Function

If this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) :thumbs_up:.

Wesley Crihfield

EESignature

(Not an Autodesk Employee)