Export Inventor Parts list with Sheets for routing etc Randomly stopped working

[t_fransman]

I have an ilogic written before my time that has stopped working. It seems to end if there are sheets that don't have a PL on them. I need to retain all attributes for the first couple sheets. Then renumber the sheets so it displays the sheet that the pl came from correctly. Please don't change the first two sheets they work as intended. Here is the code. It used to work fine before install of 2021 Inventor and maybe new excel version or update. 

Dim oDoc as Document = ThisDoc.Document
Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
Dim oSheets As Sheets = oDrawDoc.Sheets
Dim oSheet As Sheet 
Dim oRevTable As RevisionTable = oSheets(1).RevisionTables.Item(1)

RevLevel = oRevTable.RevisionTableRows.Count

'get the path and name of the drawing file
path_and_name = ThisDoc.PathAndFileName(False) ' without extension
FullName = path_and_name & ".xls"

'check for existing XLS file and delete it if found
ExistingFile = Dir(path_and_name & ".xls*")

If ExistingFile <> "" Then
	i = MessageBox.Show("The file already exists: " & vbCr & vbCr & path_and_name & ".xls" & vbCr & vbCr & "Do you want to overwrite the file?", "File Exists", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
	If i = vbYes Then
		Kill (FullName)
	Else 
		Exit Sub
	End If
Else
End If

iCount = 1

For SheetNum = oSheets.count To 1 Step -1
	
	ThisApplication.StatusBarText = "Exporting Sheet " & iCount & " of " & oSheets.count & "    Please Wait!"
	Try
		oPartslist = oSheets(SheetNum).PartsLists(1)
			
		' create a new NameValueMap object
		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") = "A2"
		
		'specify the XLS tab name
		'here the file name is used 
		oOptions.Value("TableName") = "BOM-Sheet " & SheetNum '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(FullName, PartsListFileFormatEnum.kMicrosoftExcel, oOptions)  
	
	Catch
	
	End Try
	
	
	iCount = iCount + 1
	LastSheet = SheetNum
	
Next

ThisApplication.StatusBarText = "Finalizing BOM Export     Please Wait!"
	
xlLeft = -4131
xlCenter = -4108
xlRight = -4152
xlContinuous = 1
xlEdgeLeft = 7
xlEdgeTop = 8
xlEdgeBottom = 9
xlEdgeRight = 10
xlInsideVertical = 11
xlInsideHorizontal = 12

ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = False
ExcelApp.DisplayAlerts = False
ExcelWorkbook = ExcelApp.Workbooks.Open(FullName)

'''Format Export
Dim SheetCount As Integer
Dim Fail as Boolean
Dim DropCount As Integer

SheetCount = 1

For Each sh In ExcelWorkbook.Worksheets

		sh.Range("A:G").HorizontalAlignment = xlLeft
		With sh.Range("A1:G1")
			.Value = "COMPONENT COMBINED BILL OF MATERIALS"
			.MergeCells = True
			.Font.Size = 18
			.Font.Bold = True
			.HorizontalAlignment = xlCenter
		End With
		With sh.Range("A2:G2")
			.Font.Bold = True
			.Borders(xlEdgeLeft).LineStyle = xlContinuous
			.Borders(xlEdgeTop).LineStyle = xlContinuous
			.Borders(xlEdgeBottom).LineStyle = xlContinuous
			.Borders(xlEdgeRight).LineStyle = xlContinuous
			.Borders(xlInsideVertical).LineStyle = xlContinuous
		End With
		sh.Columns("A").ColumnWidth = 8.5
		sh.Columns("B").ColumnWidth = 8.5
		sh.Columns("C").ColumnWidth = 122.5
		sh.Columns("D").ColumnWidth = 39
		sh.Columns("E").ColumnWidth = 35
		sh.Columns("F").ColumnWidth = 8
		sh.Columns("G").ColumnWidth = 24.5
		With sh.PageSetup
			.Zoom = False
			.FitToPagesWide = 1
			.FitToPagesTall = False
			.Orientation = 2
		End With
		
Next

'''Routings
RoutingSheet = ExcelWorkbook.sheets.Add
RoutingSheet.Name = "Routings"
RoutingSheet.Columns("A").ColumnWidth = 17
RoutingSheet.Columns("B").ColumnWidth = 11

With RoutingSheet.Range("A1:B1")
	.MergeCells = True
	.Value = "Shop Routings"
	.Font.Size = 18
	.Font.Bold = True
	.HorizontalAlignment = xlCenter
End With

RoutingSheet.Range("B:B").HorizontalAlignment = xlCenter
With RoutingSheet.Range("A1:B16")
	.Borders(xlEdgeLeft).LineStyle = xlContinuous
	.Borders(xlEdgeTop).LineStyle = xlContinuous
	.Borders(xlEdgeBottom).LineStyle = xlContinuous
	.Borders(xlEdgeRight).LineStyle = xlContinuous
	.Borders(xlInsideVertical).LineStyle = xlContinuous
	.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
With RoutingSheet.PageSetup
	.Zoom = False
	.FitToPagesWide = 1
	.FitToPagesTall = False
	.Orientation = 1
End With

RoutingSheet.Range("A2:B2").Font.Bold = True
RoutingSheet.Range("A2").Value = "WORK CENTER"
RoutingSheet.Range("B2").Value = "HOURS"

RoutingSheet.Range("A3").Value = "PROGRAMING"
RoutingSheet.Range("A4").Value = "BURN/CLEAN"
RoutingSheet.Range("A5").Value = "LAY/FAB"
RoutingSheet.Range("A6").Value = "MACHINING"
RoutingSheet.Range("A7").Value = "WELDING"
RoutingSheet.Range("A8").Value = "ASYTST-M"
RoutingSheet.Range("A9").Value = "CLEAN/PAIN"
RoutingSheet.Range("A10").Value = "ASYTST-E"
RoutingSheet.Range("A11").Value = "STOCKTST"


'''Properties
PropertiesSheet = ExcelWorkbook.Sheets.add
PropertiesSheet.Name = "Component Properties"
PropertiesSheet.Columns("A").ColumnWidth = 14.25
PropertiesSheet.Columns("B").ColumnWidth = 94

With PropertiesSheet.Range("A1:B1")
	.MergeCells = True
	.Value = "Job Specific Data Table & Component Properties"
	.Font.Size = 18
	.Font.Bold = True
	.HorizontalAlignment = xlCenter
End With

PropertiesSheet.Range("A2:A9").Font.Bold = True
PropertiesSheet.Range("A2").Value = "Job#"
PropertiesSheet.Range("B2").Value = iProperties.Value("Custom", "JOB NO")
PropertiesSheet.Range("A3").Value = "Mark#"
PropertiesSheet.Range("B3").Value = iProperties.Value("Custom", "MARK NO")
PropertiesSheet.Range("A4").Value = "Desc."
PropertiesSheet.Range("B4").Value = iProperties.Value("Custom", "SHORT DESC")
PropertiesSheet.Range("A5").Value = "Ext Desc."
PropertiesSheet.Range("B5").Value = iProperties.Value(iProperties.Value("Project", "Part Number")&".iam", "Project", "Description")
PropertiesSheet.Range("A6").Value = "P/N"
PropertiesSheet.Range("B6").Value = iProperties.Value("Project", "Part Number")
PropertiesSheet.Range("A7").Value = "Drawing"
PropertiesSheet.Range("B7").Value = iProperties.Value("Project", "Part Number")
PropertiesSheet.Range("A8").Value = "Revision"
PropertiesSheet.Range("B8").Value = RevLevel
PropertiesSheet.Range("A9").Value = "Make Qty"
PropertiesSheet.Range("B9").Value = iProperties.Value("Custom", "MAKE QTY")
PropertiesSheet.Range("A33").Value = "UserID"
PropertiesSheet.Range("B33").Value = System.Environment.UserName
PropertiesSheet.Range("A34").Value = "MachineID"
PropertiesSheet.Range("B34").Value = System.Environment.MachineName

PropertiesSheet.Range("B:B").HorizontalAlignment = xlLeft
With PropertiesSheet.Range("A1:B9")
	.Borders(xlEdgeLeft).LineStyle = xlContinuous
	.Borders(xlEdgeTop).LineStyle = xlContinuous
	.Borders(xlEdgeBottom).LineStyle = xlContinuous
	.Borders(xlEdgeRight).LineStyle = xlContinuous
	.Borders(xlInsideVertical).LineStyle = xlContinuous
	.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With

With PropertiesSheet.PageSetup
	.Zoom = False
	.FitToPagesWide = 1
	.FitToPagesTall = False
	.Orientation = 2
End With
 
ExcelWorkbook.Save

i = MessageBox.Show("Export completed successfully!" & vbCr & vbCr & "Would you like to view the output now?", "Export Complete", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
If i = vbNo Then
	ExcelWorkbook.Close
	ExcelApp.Quit
Else
	ExcelApp.Visible = True
End If

ExcelWorkbook = Nothing
ExcelApp = Nothing

[t_fransman]

only gets last sheet instead of first now

[WCrihfield]

I was not able to copy & paste your latest code into a rule to review it.  I have no idea why it would suddenly only process the 10th sheet.  I'm sorry but I am honestly running out of ideas for this scenario.  It can be very challenging trying to diagnose this sort of thing remotely, especially when testing the code before posting it is not an option, because all the original documents & resources are not available.

In your post (message 13), you said "seems that it doesn't appear in my list of installed, must be networked."  What did you mean by that?  Is Microsoft Excel not installed locally on your computer?

[t_fransman]

NO sorry it was installed as Office suite . I re-installed it. NO idea this one skips to the last sheet and makes a tab for it. Similiar issue just in reverse. 

[A.Acheson]

Just a thought but perhaps you could simply add the excel sheets you need after the partslist export inside the drawing sheet loop and using the direct excel add sheet method.

https://docs.microsoft.com/en-us/office/vba/api/excel.sheets.add

[t_fransman]

Can't understand why it used to work fine. But somewhere in here it just fails to move on. 

For SheetNum = oSheets.count To 1 Step -1
	
	ThisApplication.StatusBarText = "Exporting Sheet " & iCount & " of " & oSheets.count & "    Please Wait!"
	Try
		oPartslist = oSheets(SheetNum).PartsLists(1)
			
		' create a new NameValueMap object
		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") = "A2"
		
		'specify the XLS tab name
		'here the file name is used 
		oOptions.Value("TableName") = "BOM-Sheet " & SheetNum '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(FullName, PartsListFileFormatEnum.kMicrosoftExcel, oOptions)  
	
	Catch
	
	End Try
	
	
	iCount = iCount + 1
	LastSheet = SheetNum

If i play with the step numbers i get different sheets but always only one sheet now.  

[JelteDeJong]

It seems that the export function does not create new tab pages (anymore). All rows are written to the first sheet (in the excel file) Also the existing rows are not removed but just overwritten. (That alone can give unexpected results) You can show this by moving that start cell for each parts list. Try the following rule. It will put all parts list on 1 sheet. That is probably not what you want but it shows the problem.

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


'Dim oRevTable As RevisionTable = oSheets(1).RevisionTables.Item(1)
Dim RevLevel = 1 'oRevTable.RevisionTableRows.Count

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

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 sheetNumber = 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") = "BOM-Sheet-" & sheetNumber '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)

        startRow = startRow + oPartslist.PartsListRows.Count + 2
        sheetNumber = sheetNumber + 1
        includeTitle = False
    Catch ex As Exception
        MsgBox(String.Format("could not export partslist on sheet: {0} ({1})", Sheet.Name, ex.Message))
    End Try
Next

[t_fransman]

Thanks this has all been enlightening. Be nice

if it just made a tab for every sheet regardless and delete the tabs with no bom as long as the tabs retained sheet number. 

[WCrihfield]

Great observation @JelteDeJong.  I did not try local testing of the export process, because the code was so custom, and I pretty much never have more than one PartsList in any drawing, so I did not have a good test subject anyways.

@t_fransman  I would not give up on the idea (or cabability) of getting the data from each exported parts list onto different sheets in an excel file.  As I mentioned before, the options are fairly wide open, and there is often more than one way to do things.  One thing that comes to mind is that if need be, we could export each parts list to a different excel file (add an incremental digit to end of Excel file name), then one way or another merge the excel files together, then get rid of the other unneeded Excel files.  Another thought would be to use the Worksheet.Copy() method to copy the first exported data to another sheet, then clear the data on the original sheet, to prepare it for the next export.  That is just two of many thoughts.  There are lots of ways to manipulate, move, copy/paste excel data from one place to another, so I still believe it is possible to end up with the end result you are after.  If you need hep getting there, just ask.

[t_fransman]

Currently since it stopped working we copy the tab, delete the data, rename the tab, go to inventor copy the new BOM on whichever sheet an paste it to the copy. It's time consuming and potential for error. But, if careful it works. Not sure why other than sabotage it stopped working. Sorry I'm at a loss to get it back on track i'd need to just add all the sheets on seperate tabs and than manually delete the ones without BOM's on them perhaps. Not ideal but if easier, it 'd be a start. 

[t_fransman]

Wanted to thank everyone. Something must have changed in excel or Autodesk since the original code i had now once again works as intended. I.e skips sheets when a sheet without a bom is present and continues.