Export all part lists in a drawing to one excel file

[eladm]

Hi

Can I get help of creating one excel file (drawing inventor file.xlsx) with all the part lists from all the sheets in the drawing ? I want a ilogic rule

I have this rule to create each part list to excel file (I want to combine the excel)

' Export Parts List to Excel'---------------------------

Sub main() 

Dim oDoc As DrawingDocument 

oDoc = ThisApplication.ActiveDocument   

Dim oSheet As Sheet 

Dim oPartList As PartsList 

Dim Sheetcnt As Integer 

Dim Partlistcnt As Integer 

Dim filename As String 

Sheetcnt = 1 

Partlistcnt = 1 

For Each oSheet In oDoc.Sheets  

  For Each oPartList In oSheet.PartsLists          filename="C:\Temp\Sheet" & Sheetcnt & "_Partlist" & Partlistcnt & ".xlsx"       

  MsgBox(filename)      

    Partlistcnt = Partlistcnt + 1          Call oPartList.Export(filename, PartsListFileFormatEnum.kMicrosoftExcel)   

Next        

Sheetcnt=Sheetcnt+1 

Next

End Sub 

*****

Thx in advance

[A.Acheson]

Here is a rule modified from here  See how it works for you.  

Dim oDoc As Document = ThisDoc.Document
Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
Dim oSheets As Sheets = oDrawDoc.Sheets

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

If (IO.File.Exists(fileName)) Then
    Dim result = MessageBox.Show("The file already exists: " & vbCr & vbCr & fileName & vbCr & vbCr & "Do you want to overwrite the file?", "File Exists", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
    If result = vbYes Then
        IO.File.Delete(fileName)
    Else
        Exit Sub
    End If
Else
End If

Dim startRow = 2
Dim includeTitle = True
Dim PartsListNumber = 1
For Each sheet As Sheet In oSheets 

    ThisApplication.StatusBarText = "Exporting Sheet " & Sheet.Name & " of " & oSheets.Count & "    Please Wait!"
    Try
        Dim oPartslist As PartsList = Sheet.PartsLists(1)

        ' 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          
        oOptions.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION"

        'specify the start cell
        oOptions.Value("StartingCell") = "A" & startRow

        'specify the XLS tab name
        'here the file name is used 
        oOptions.Value("TableName") = "PartsList-" & PartsListNumber 'without extension

        'choose to include the parts list title row
        'in this example "Ye Old List of Parts" is written to the StartingCell 
        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

    Catch ex As Exception
        'MsgBox(String.Format("could not export partslist on sheet: {0} ({1})", Sheet.Name, ex.Message))
    End Try
Next

[eladm]

Hi

Thanks' a lot ,but

If we have more than 1 part list in a sheet (inventor), in the excel we have only the 1st part list and not the other

After change the part list ,( add or remove column )it don't update the excel or skip a sheet in a drawing

[A.Acheson]

Your original code has a for loop for partslist place that instead of 

Dim oPartslist As PartsList = Sheet.PartsLists(1)

[eladm]

sorry , I didn't understand

the rule I attached create for each part list an Excel file , (even if I have couple of part list in one Inventor drawing sheet)

I need all the part lists in the file to one excel file

[A.Acheson]

Delete this line which is a direct reference to the first partslist object on this sheet

Dim oPartslist As PartsList = Sheet.PartsLists(1)

Rearrange the object looping like this. The for each oPartList  will find every partslist object on that sheet and carry out any operation in that loop. 

For Each sheet As Sheet In oSheets 
    For Each oPartList In oSheet.PartsLists 

'***********Paste in the rest of the code********
     Next
Next
  

 When you have that done test and reply back with any issues you have. 

[eladm]

Sorry , the 1st - delete the line - understand

I didn't understand what to do the 2nd - rearrange

regards

[A.Acheson]

Here is the working rule with added launch excel workbook at the end of the rule. 

Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
Dim oSheets As Sheets = oDrawDoc.Sheets

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

If (IO.File.Exists(fileName)) Then
    Dim result = MessageBox.Show("The file already exists: " & vbCr & vbCr & fileName & vbCr & vbCr & "Do you want to overwrite the file?", "File Exists", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
    If result = vbYes Then
        IO.File.Delete(fileName)
    Else
        Exit Sub
    End If
Else
End If

Dim startRow = 1
Dim includeTitle = True
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
    	
		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          
        oOptions.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION"

        'specify the start cell
        oOptions.Value("StartingCell") = "A" & startRow

        'specify the XLS tab name
        'here the file name is used 
        oOptions.Value("TableName") = "PartsList-" & PartsListNumber 'without extension

        'choose to include the parts list title row
        'in this example "Ye Old List of Parts" is written to the StartingCell 
        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


	Next
Next



	Dim Complete = MessageBox.Show("All Done with Partslist Export" & vbCr & vbCr & fileName & vbCr & vbCr _
	& "Do you want to open the file?", "Part List Export", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
    
	If Complete = vbYes Then
        ThisDoc.Launch(fileName)
    Else
        Return
    End If

[eladm]

The rule bring only

description , Part number and QTY

no other column

If one of the column is missing - error in line 51, 

[A.Acheson]

The column titles are optional. either place in all the column titles that you want to show up and exist in all PartsList or comment it out and all columns will be exported

    'specify the Columns To export          
       ' oOptions.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION"

[eladm]

After add the column - I still get an error , line 51

But , why I need to specified the column ? not good

[A.Acheson · Accepted solution]

If all of the partslist column headers are not the same then you will continue to receive the error. Please remove or comment the option for exported columns. If the issues still persist, can you please provide the error message and indicate where the error is. I am still using INV 2020 which has no line numbers. 

Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
Dim oSheets As Sheets = oDrawDoc.Sheets

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

If (IO.File.Exists(fileName)) Then
    Dim result = MessageBox.Show("The file already exists: " & vbCr & vbCr & fileName & vbCr & vbCr & "Do you want to overwrite the file?", "File Exists", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
    If result = vbYes Then
        IO.File.Delete(fileName)
    Else
        Exit Sub
    End If
Else
End If

Dim startRow = 1
Dim includeTitle = True
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
    	
		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

        'specify the XLS tab name
        'here the file name is used 
        oOptions.Value("TableName") = "PartsList-" & PartsListNumber 'without extension

        'choose to include the parts list title row
        'in this example "Ye Old List of Parts" is written to the StartingCell 
        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


	Next
Next



	Dim Complete = MessageBox.Show("All Done with Partslist Export" & vbCr & vbCr & fileName & vbCr & vbCr _
	& "Do you want to open the file?", "Part List Export", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
    
	If Complete = vbYes Then
        ThisDoc.Launch(fileName)
    Else
        Return
    End If