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: emanuel.c

Hi @emanuel.c.  I copied, then simplified and shortened the code a bit, and think I may have fixed some things along the way.  Try this version.

Sub Main()
	If Not ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
		MessageBox.Show("Hey this rule only runs in drawing documents!")
		Exit Sub
	End If
	Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oSheets As Inventor.Sheets = oDrawDoc.Sheets
	Dim oLongestPL As PartsList = Nothing
	Dim iMostRows As Integer = 0
	Dim iSheetNumber As Integer = 0
	For Each oSheet As Inventor.Sheet In oSheets
		Dim oPLs As PartsLists = oSheet.PartsLists
		If oPLs.Count = 0 Then Continue For
		For Each oPL As PartsList In oPLs
			If oPL.PartsListRows.Count > iMostRows Then
				iMostRows = oPL.PartsListRows.Count
				oLongestPL = oPL
				iSheetNumber = CInt(oSheet.Name.Split(":").Last)
			End If
		Next	
	Next
	ExportPartsList(oDrawDoc, oLongestPL)
End Sub

Sub ExportPartsList(oDrawDoc As DrawingDocument, oLongestPL As PartsList)
	oDrawDoc.Activate
	'get the path and name of the drawing file
	Dim fileName As String  = IO.Path.GetFileNameWithoutExtension(oDrawDoc.FullFileName)
	'Logger.Info("FileName: " & fileName)
	Dim fullFileName As String = oDrawDoc.FullFileName
	
	'Dim FilePath As String = Left(FullFileName, InStrRev(FullFileName, "\"))
	Dim filePath As String
	Try
		filePath = IO.Path.GetDirectoryName(oDrawDoc.FullFileName) & "\"
	Catch
		MessageBox.Show("You need to save the file first!", "Error: No Filename")
		Exit Sub
	End Try
	
	Dim excelName As String = filePath & "BOM for - " & fileName & ".xlsx"
	'Logger.Info("ExcelName: " & excelName)
	
	If IO.File.Exists(excelName) Then
		'Ask to overwrite Excel File
'		Dim result As MsgBoxResult = MessageBox.Show("The Excel file already exists: " & _
'									vbCr & vbCr & excelName & vbCr & vbCr & "Do you want to overwrite the file?", "File Exists", _
'									MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
'		If result = MsgBoxResult.Yes Then
			Try 'So as to overwrite.
				IO.File.Delete(excelName) 
			Catch
				MessageBox.Show("Is it perhaps opened?", "Could Not Overwrite Excel File")
				'drawDoc.Close(True)
				Exit Sub
			End Try
'		Else
'			'drawDoc.Close(True)
'			Exit Sub
'		End If
	Else
	End If
     
	'Create a new NameValueMap object.
	Dim options As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	
	'Specify an existing template file.
	'To use For formatting colors, fonts, etc.
	options.Value("Template") = "M:\Autodesk Inventor\Ilogic\BOM Template.xlsx"
	
	'Specify the Columns To export(all columns need to be in the partslist).
	'options.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION"
	
	'Specify the start cell.
	options.Value("StartingCell") = "A" & startRow + 4
	
	'Naming the Tab in Excel	
	options.Value("TableName") = "Parts List" 
		
	'Choose to include the parts list title row.
	options.Value("IncludeTitle") = False		
	
	'Choose to autofit the column width in the xls file
	options.Value("AutoFitColumnWidth") = True
    
	'export the Partslist to Excel with options
	oLongestPL.Export(excelName, PartsListFileFormatEnum.kMicrosoftExcel, options)
	'Do you want to close the document afterwards?
	'oDoc.Close(True)
	
	GoExcel.Open(excelName, options.Value("TableName"))
	GoExcel.CellValue(excelName, options.Value("TableName"), "A1") = "PARTS LIST FOR"
	GoExcel.CellValue(excelName, options.Value("TableName"), "A2") = fileName	
	GoExcel.Save
	GoExcel.Close
End Sub

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)