Export Excel parts list of all dwg files in folder

[emanuel.c]

I would like to export to Excel the parts list of all DWG files in a folder. Typically the first parts list in the first sheet is sufficient for my needs. I used this code from here https://forums.autodesk.com/t5/inventor-ilogic-and-vb-net-forum/ilogic-and-export-parts-list-in-a-id... but can't get it to work properly for all the files in the folder.

I wish to iterate through all the DWG files in the folder, open the DWG file, export the Parts List and close the file. Where am I messing up here?

Many thanks!

Public Sub Main()
	
	Dim wFolder As String = "C:\Inventor\test"
	Dim FileLocation As System.IO.DirectoryInfo = New System.IO.DirectoryInfo(wFolder)
	Dim fi As System.IO.FileInfo() = FileLocation.GetFiles()	
			For Each oFile As System.IO.FileInfo In fi
				'Get only DWG files - Not PDFs or other files
				DwgFile = Left(oFile.FullName, Len(oFile.FullName) -3) & "dwg"				
				ThisApplication.Documents.Open(DwgFile, True)
				ExportPartsList				
			Next	

End Sub

Public Sub ExportPartsList
	Dim oDoc As Inventor.Document = ThisApplication.ActiveDocument
	Dim oSheets As Sheets = oDoc.Sheets

	'get the path and name of the drawing file
	Dim fileName = ThisDoc.PathAndFileName(False) & ".xlsx"
	
	If (IO.File.Exists(fileName)) Then
		'delete so as to overwrite
		IO.File.Delete(fileName)
	End If
	
	Dim oParents, otitles As New ArrayList
	
	Dim startRow = 1
	Dim includeTitle = False
	Dim PartsListNumber = 1
	Dim oPartslist As PartsList
	For Each sheet As Sheet In oSheets 'Find every sheet in the drawing
		For Each oPartslist In Sheet.PartsLists 'Find every partslist on the sheet
	
			If Not oParents.Contains(oPartslist.ReferencedDocumentDescriptor.FullDocumentName) Then
				oParents.Add(oPartslist.ReferencedDocumentDescriptor.FullDocumentName)
			
			ThisApplication.StatusBarText = "Exporting Sheet " & Sheet.Name & " of " & oSheets.Count & " Please Wait!"
			
			' create a new NameValueMap object
			Dim oOptions = ThisApplication.TransientObjects.CreateNameValueMap
			
			'specify the start cell
			oOptions.Value("StartingCell") = "A" & startRow
			
			'specify the XLS tab name. Here the file name is used
			If Not otitles.Contains(oPartslist.Title) Then
				otitles.Add(oPartslist.Title)
				oOptions.Value("TableName") = oPartslist.Title
			Else
				oOptions.Value("TableName") = oPartslist.Title & PartsListNumber
			End If
			
			'choose to include the parts list title row
			oOptions.Value("IncludeTitle") = False
			
			'choose to autofit the column width in the xls file
			oOptions.Value("AutoFitColumnWidth") = True
			
			' export the Partslist to Excel with options
			oPartslist.Export(fileName, PartsListFileFormatEnum.kMicrosoftExcel, oOptions)
			
			PartsListNumber = PartsListNumber + 1
			Else
				Logger.Info(Sheet.Name & ": there is already a partslist exported for file reference " & oPartslist.ReferencedDocumentDescriptor.FullDocumentName)
			End If
			
			Next
		Next
			
	oDoc.Close(True)

End Sub

[A.Acheson]

Hi @emanuel.c 

Can you share which line the error occurs? Can you screenshot the more info tab of error message? 

Is this filename returning the correct filename? 

'get the path and name of the drawing file
	Dim fileName = ThisDoc.PathAndFileName(False) & ".xlsx"
	

Can you place a message box and step through the code starting where you thing the code fails? 

You can also be more specific about what files your searching for as your current code has no error handling. Here is a article that searches for files of a given extension.

Get all of the drawing files in the directory and subdirectories.
Dim drawings() As String = System.IO.Directory.GetFiles( _
                           txtPath.Text, _
                           "*.idw", _
                           System.IO.SearchOption.AllDirectories)

' Iterate through the found drawings.
For Each drawing As String In drawings
    Dim drawDoc As Inventor.DrawingDocument
    drawDoc = invApp.Documents.Open(drawing)

    ' Save the PDF.
    SaveAsPDF(drawDoc, _
              System.IO.Path.ChangeExtension(drawing, "pdf"))

    ' Close the drawing.
    drawDoc.Close(True)
Next

[emanuel.c]

Hi Alan, thanks for looking into it! I modified it slightly but I think the issue is with my iteration. The second sub works very well on its own - if I run it in a single drawing it exports the Parts List. But I can't get it to iterate through all the drawings in that folder, open each drawing, export the parts list (it also modifies the title in the A1 column of Excel) and closes the Excel and drawing (haven't been successful at closing the Excel for now). As I have it now, it opens the first drawing in the folder, exports the parts list and then when it opens the next drawing it wants to overwrite the Excel file it just created instead of writing a new Excel with its Parts List.

Thanks again!

Public Sub Main()
	
	Dim wFolder As String = "C:\test"
	Dim FileLocation As System.IO.DirectoryInfo = New System.IO.DirectoryInfo(wFolder)
	Dim fi As System.IO.FileInfo() = FileLocation.GetFiles()	
			For Each oFile As System.IO.FileInfo In fi
				'Get only DWG files - Not PDFs or other files
				DwgFile = Left(oFile.FullName, Len(oFile.FullName) -3) & "dwg"				
				Try
					ThisApplication.Documents.Open(DwgFile, True)
					ExportPartsList
				Catch
					'MessageBox.Show("Drawing Is Already Opened", "Title")
				End Try
			Next		

End Sub

Public Sub ExportPartsList
	Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
	Dim oSheets As Sheets = oDrawDoc.Sheets
	
	'get the path and name of the drawing file
	Dim FileName = ThisDoc.FileName(False)
	FullFileName = ThisApplication.ActiveDocument.FullFileName
	FilePath = Left(FullFileName, InStrRev(FullFileName, "\"))
	ExcelName = FilePath & "BOM for - " & FileName & ".xlsx"
		
	If (IO.File.Exists(ExcelName)) Then
		Dim result = 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 = vbYes Then
			Try
				IO.File.Delete(ExcelName) 'so as to overwrite
			Catch
				MessageBox.Show("Is it perhaps opened?", "Could Not Overwrite Excel File")
				Exit Sub
			End Try
		Else
			Exit Sub
		End If
	Else
	End If
	
	Dim oParents, otitles As New ArrayList
	
	Dim startRow = 1
	Dim includeTitle = False
	Dim PartsListNumber = 1
	Dim oPartslist As PartsList
	For Each sheet As Sheet In oSheets 'Find every sheet in the drawing
		For Each oPartslist In Sheet.PartsLists 'Find every partslist on the sheet
	
			If Not oParents.Contains(oPartslist.ReferencedDocumentDescriptor.FullDocumentName) Then
				oParents.Add(oPartslist.ReferencedDocumentDescriptor.FullDocumentName)
			
			ThisApplication.StatusBarText = "Exporting Sheet " & Sheet.Name & " of " & oSheets.Count & " Please Wait!"
			
			' create a new NameValueMap object
			Dim oOptions = ThisApplication.TransientObjects.CreateNameValueMap
			
			'specify an existing template file
			'to use For formatting colors, fonts, etc
			'oOptions.Value("Template") = ThisDoc.Path & "\BOM Template.xlsx"
			
			'specify the Columns To export(all columns need to be in the partslist)
			'oOptions.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION"
			
			'specify the start cell
			oOptions.Value("StartingCell") = "A" & startRow+1
			
			'specify the XLS tab name
			oOptions.Value("TableName") = "Parts List" 'FileName
			
			'choose to include the parts list title row
			oOptions.Value("IncludeTitle") = True		
			
			'choose to autofit the column width in the xls file
			oOptions.Value("AutoFitColumnWidth") = True
			
			' export the Partslist to Excel with options
			oPartslist.Export(ExcelName, PartsListFileFormatEnum.kMicrosoftExcel, oOptions)
			
			PartsListNumber = PartsListNumber + 1
			Else
				Logger.Info(Sheet.Name & ": there is already a partslist exported for file reference " & oPartslist.ReferencedDocumentDescriptor.FullDocumentName)
			End If
			
			Next
			Next 
	
	ThisDoc.Launch(ExcelName)
	GoExcel.CellValue(ExcelName, "Parts List", "A1") = "Parts List For: " & FileName
	GoExcel.CellValue(ExcelName, "Parts List", "A2") = ""
	GoExcel.Save
	GoExcel.Close
	
	oDrawDoc.Close(True)

End Sub

[A.Acheson]

Hi @emanuel.c 

These lines here are going to be an issue. They are ilogic functions and work great when you launch the rule from the document you need to process. 

Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
	Dim oSheets As Sheets = oDrawDoc.Sheets
	
	'get the path and name of the drawing file
	Dim FileName = ThisDoc.FileName(False)

As they will always reference your launching document for the rule rather than the open document. You should pass the document through after you have opened it. 

DwgFile = Left(oFile.FullName, Len(oFile.FullName) -3) & "dwg"
Dim drawDoc As Inventor.DrawingDocument = invApp.Documents.Open(DwgFile)
ExportPartsList(drawDoc)

 Then for any filenames you need in the sub routine either pass them in as an argument or use System.IO methods to extract them.

[A.Acheson · Accepted solution]

Hi @emanuel.c 

Using "Option Explicit on" I see a few declarations are missing. These don't immediately indicate an error but without these declarations there can be unpredictable results. 

Incorrect target Document:

With the logger switched on you can see an error occurring in every sub routine due to the rule targeting the launching document in this case an assembly file. 

Incorrect target Document:

And again with new target document and  the logger switched on you can see  the rule is  targeting the  launching document in this case an assembly file. 

Also the writing to excel error is due to opening the excel workbook in windows. This step isn't necessary as go excel function will open invisible and write to the excel workbook. If you need to  open the workbook do so  after it has been saved and closed. 

Working rule:

Option Explicit On
Public Sub Main()
	
	Dim folder As String = "C:\test"
	Dim fileLocation As System.IO.DirectoryInfo = New System.IO.DirectoryInfo(folder)
	Dim fi As System.IO.FileInfo() = fileLocation.GetFiles()
	
	For Each docfile As System.IO.FileInfo In fi
		'Avoid non .dwg extensions.
		If Not docfile.Extension = ".dwg" Then Continue For
		'Get only DWG files - Not PDFs or other files.
		Dim dwgFile As String = Left(docfile.FullName, Len(docfile.FullName) -3) & "dwg"	
		
		Try 
			Dim drawDoc As DrawingDocument = ThisApplication.Documents.Open(dwgFile, True)
			'Logger.Info("DWGFile Before Launch Sub Routine: " & dwgFile)
			
			'Pass drawing document as argument to sub routine.
			ExportPartsList(drawDoc)
		Catch
			Logger.Info("Error in Sub Routine: ")
		End Try
	Next		

End Sub

Public Sub ExportPartsList(drawDoc As DrawingDocument)
	
	drawDoc.Activate
	'Logger.Info("DWGFile After Getting Document in Sub Routine: " & drawDoc.FullFileName)

	'get the path and name of the drawing file
	Dim fileName As String  = IO.Path.GetFileNameWithoutExtension(drawDoc.FullFileName)
	'Logger.Info("FileName: " & fileName)
	Dim fullFileName As String = drawDoc.FullFileName
	'Dim FilePath As String = Left(FullFileName, InStrRev(FullFileName, "\"))
	Dim filePath As String = IO.Path.GetDirectoryName(drawDoc.FullFileName) & "\"
	Dim excelName As String = filePath & "BOM for - " & fileName & ".xlsx"
	'Logger.Info("ExcelName: " & excelName)

	If IO.File.Exists(excelName) Then
		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
	
	Dim parents As New List (Of String)
	
	Dim startRow = 1
	Dim includeTitle = False
	Dim partsListNumber = 1
	Dim sheets As Sheets = drawDoc.Sheets
	
	'Find every sheet in the drawing.
	For Each sht As Sheet In sheets 
		'Find every partslist on the sheet.
		For Each prtslist As PartsList In sht.PartsLists 
			If Not parents.Contains(prtslist.ReferencedDocumentDescriptor.FullDocumentName) Then
				parents.Add(prtslist.ReferencedDocumentDescriptor.FullDocumentName)
			
				ThisApplication.StatusBarText = "Exporting Sheet " & sht.Name & " of " & sheets.Count & " Please Wait!"
				
				'Create a new NameValueMap object.
				Dim options = ThisApplication.TransientObjects.CreateNameValueMap
				
				'Specify an existing template file.
				'To use For formatting colors, fonts, etc.
				'options.Value("Template") = filePath & "\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+1
				
				'Specify the XLS tab name.
				options.Value("TableName") = "Parts List" 
				
				'Choose to include the parts list title row.
				options.Value("IncludeTitle") = True		
				
				'Choose to autofit the column width in the xls file
				options.Value("AutoFitColumnWidth") = True
				
				'Export the Partslist to Excel with options.
				prtslist.Export(excelName, PartsListFileFormatEnum.kMicrosoftExcel, options)
				
				partsListNumber = partsListNumber + 1
			Else
				Logger.Info(sht.Name & ": there is already a partslist exported for file reference " & prtsList.ReferencedDocumentDescriptor.FullDocumentName)
			End If
			
		Next
	Next 
	
	drawDoc.Close(True)
	'Cannot use launch as this will void access using go excel(file open becomes read only),
	'instead just write directly using go excel functions.
	'ThisDoc.Launch(excelName)
	GoExcel.CellValue(excelName, "Parts List", "A1") = "Parts List For: " & fileName
	GoExcel.CellValue(excelName, "Parts List", "A2") = ""
	GoExcel.Save
	GoExcel.Close
	
End Sub

[emanuel.c]

Wow you took the time to explain all that! Thank you so much! I keep learning a bit more each time.

[A.Acheson]

No problem at all, it is easier to post a few photos with the explanation of the debugging than trying to explain with words alone. Just remember those ilogic snippets are great in single document use but are not great when it comes to multiple document processing.