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

t_fransman · ‎02-03-2022

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

WCrihfield · ‎02-03-2022

Hi @t_fransman. Wow, that is a lot of highly custom stuff, and would be tough to fully debug without being able to test it. As for your one concern that you want to leave the first two sheets alone. I think that part should be fairly easy to achieve. You have the following line at the start of the main 'loop' in the code:

For SheetNum = oSheets.count To 1 Step -1

I believe you can simply change the 'To 1' to 'To 3'.

For SheetNum = oSheets.count To 3 Step -1

That way, while it is working from last sheet back towards the first sheet, it will stop at the 3rd sheet. But even this can be risky, because you must have more than 3 sheets, or the loop will not work. You would probably just have to add a line of code just before that, which checks the oSheets.Count to make sure it is 4 or more, or else either exit the rule, or skip the loop entirely.

Also, it seems to me like you may be 'flying blind' so to speak (without any help from Intellisense) throughout most of the Excel related stuff in your code. You may be able to change that by adding the proper 'Header' lines (AddReference, & Imports) at the very top, before all other code, or within the Header of the rule, then simply define object variable types a bit more down within the code, so that it can recognize all those Excel specific objects, and know what Properties & Methods are available to them.

Here are three very useful lines of code that you can put into the Header area of your rule to get you started.

AddReference "Microsoft.Office.Interop.Excel.dll"
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Excel

Then, down within your code, starting with the oExcelApp variable, you can define the variable's Type as Excel.Application, then continue that trend on down through your other Excel related object variables. That will help enable iLogic's Intellisense (pop-up help/hints) while dealing with all that Excel stuff.

Wesley Crihfield

(Not an Autodesk Employee)

t_fransman · ‎02-03-2022

True story. I am flying semi blind. It worked perfectly before now it bombs if the second sheet of inventor has no bill and wont go on to check the rest and rename them as the correct sheet. No idea why just stopped working on this release of either inventor or excels latest. Seems more like when we went to inventor 2021 is when it failed.

t_fransman · ‎02-03-2022

now i t errors on line 5

Rule Compile Errors in Export BOM and Properties-4, in 2657A01.idw

Error on Line 5 : 'Sheets' is ambiguous, imported from the namespaces or types 'Inventor, Microsoft.Office.Interop.Excel'.

i think this one

Dim oSheets As Sheets = oDrawDoc.Sheets

WCrihfield · ‎02-03-2022

OK. I understand the new issue with that line. That is because 'Sheets' is an object which exists in both Inventor and in Excel, and is defined differently in each. To fix this little issue, simply use 'Inventor.Sheets' instead of just 'Sheets'.

Dim oSheets As Inventor.Sheets = oDrawDoc.Sheets

You generally only run into issues like that when you are referencing other datasets like this situation.

I still haven't quite figured the other part out though. I don't know if putting something within the Catch part of the Try...Catch block within your loop of the drawing sheets would do any good or not, but that is where you could do an alternate action when it fails to find a PartsList on that sheet.

Wesley Crihfield

(Not an Autodesk Employee)

t_fransman · ‎02-07-2022

I still only get the one sheet it doesn;'t grab the next sheet or renumber based on sheets that have a bill any more. I added the

Dim oSheets As Inventor.Sheets = oDrawDoc.Sheets. Changing

For SheetNum = oSheets.Count To 1 Step -1

just changes the single sheet ot actually grabs. Adding the intro bit either makes it error or same result. Still lost.

Thanks for taking a look. Please let me know if i am missing some thing. HAs to be in the first part, just wont get more than one sheet especially if a sheet on the idw has no bill.

Dim oDoc As Document = ThisDoc.Document
Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
Dim oSheets As Inventor.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

A.Acheson · ‎02-08-2022

I see this post here is a duplicate post of this one. https://forums.autodesk.com/t5/inventor-ilogic-api-vba-forum/inventor-i-logic-bombs-at-second-sheet-...

OP Reponse:

It creates a title page that imports into our B.O.M. software as sheet one, a routings page which imports as sheet two ( both work. But it used to get all the B.O.M. sheet and make a tab for each with the proper number for each sheet. Now it stops if the idw has a sheet that without a B.O.M.on it. I need it to continue and skip the sheets with no B.O.M. and get the rest. It used to say the correct sheet numbers for each sheet with a B.O.M. on it. That went directly into our BOM software, so a note was created saying which idw sheet each B.O.M. was on in our B.O.M. software. Worked perfectly before, still does except to some degree, the only issue is that it stops if there is no B.O.M. on any sheet in idw. No idea why always worked fine until in installed inventor 2021.

For simplicity I will respond here. I see that your referring to excel sheets. As there is drawing sheets and excel sheets please refer to them as either one as reader will get confused as to what is happening.

What I’m getting from your request is that you want each drawing sheet name to show up in the excel sheet name and have the partslist exported to one of these sheets and renamed to pinpoint the location.

Looking at the code( have not tested this ) because the table name option is in the try code it is now not setting the excel sheet name. Can you bring all the options outside that need to run per sheet and leave the try catch exclusively for the parts list check in the drawing sheet and the export to excel sheet?

Why it would have worked before is anyone guess as the try catch statement should have prevented that variable from being seen and adding the excel sheet.

If this solved a problem, please click (accept) as solution.‌‌‌‌
Or if this helped you, please, click (like)‌‌
Regards
Alan

t_fransman · ‎02-08-2022

Yes, i was thinking this was better suited for customization, so re posted. Not understanding "Looking at the code( have not tested this ) because the table name option is in the try code it is now not setting the excel sheet name. Can you bring all the options outside that need to run per sheet and leave the try catch exclusively for the parts list check in the drawing sheet and the export to excel sheet? " Sorry just lost on what that means.

WCrihfield · ‎02-08-2022

I basically just went through and reformatted the code a bit and isolated the two main processes out into Sub routines. I did a couple things slightly differently, and defines a few variables' Types. Also, I'm looping through the sheets a bit different than you were. Instead of starting with the last sheet, then working backwards, it processes them in natural order. Also it extracts the Integer at the end of the Sheet.Name (after ":") to get the sheet number. That Integer will always be there, and will always be in order. When looping through the drawing sheets, the first thing it checks is if the sheet has a PartsList on it. If it does not, it immediately skips to the next sheet. The only thing within the Try...Catch block is the actual export line, then I added a message for when that fails, just so you know, but that message can be commented out. You can give this version of your code a try and see if it works any better for you if you want.

The code is in the attached text file (to help keep the post shorter).

Wesley Crihfield

(Not an Autodesk Employee)

t_fransman · ‎02-08-2022

Wow thanks so much. Got an error when i run it. Stops the process

System.InvalidCastException: Unable to cast COM object of type 'Microsoft.Office.Interop.Excel.ApplicationClass' to interface type 'Microsoft.Office.Interop.Excel._Application'. This operation failed because the QueryInterface call on the COM component for the interface with IID '{000208D5-0000-0000-C000-000000000046}' failed due to the following error: Element not found. (Exception from HRESULT: 0x8002802B (TYPE_E_ELEMENTNOTFOUND)).
at System.StubHelpers.StubHelpers.GetCOMIPFromRCW(Object objSrc, IntPtr pCPCMD, IntPtr& ppTarget, Boolean& pfNeedsRelease)
at Microsoft.Office.Interop.Excel.ApplicationClass.set_Visible(Boolean RHS)
at ThisRule.FormatExportedData(String oExcelFile, Int32 oRevLevel)
at ThisRule.Main()
at Autodesk.iLogic.Exec.AppDomExec.ExecRuleInAssembly(Assembly assem)
at iLogic.RuleEvalContainer.ExecRuleEval(String execRule)

t_fransman · ‎02-09-2022

Unable to cast COM object of type 'Microsoft.Office.Interop.Excel.ApplicationClass' to interface type 'Microsoft.Office.Interop.Excel._Application'. This operation failed because the QueryInterface call on the COM component for the interface with IID '{000208D5-0000-0000-C000-000000000046}' failed due to the following error: Element not found. (Exception from HRESULT: 0x8002802B (TYPE_E_ELEMENTNOTFOUND)).

t_fransman · ‎02-09-2022

going to try a repair or re-install on office or excel. I'll let you know if that fixes it.

t_fransman · ‎02-09-2022

seems that it doesn't appear in my list of installed, must be networked.

WCrihfield · ‎02-09-2022

Hi @t_fransman. I see others have that type of error a lot, but am not 100% sure why. It is difficult to explain, but the Excel.Application is actually an 'Interface', while the object created by:

Dim oExcel As Excel.Application = New Excel.Application

is actually an 'Excel.ApplicationClass' which is a 'Class'. An Interface and a Class are similar, but not the same. When you hover you mouse over the oExcel variable after its definition line, you will still see Excel.Application, but when you use TypeName(oExcel), you get Excel.ApplicationClass (even if you use the CreateObject() to define it). You could try changing how you define the oExcelApp variable in your code, and see if that helps this situation. Here are a few different ways to define it when you always just want to initiate a new instance of Excel.

Here is a small sample iLogic code you can play with to try to eliminate that error. If using one of these will eliminate the error, while others still give you the error, then you know how your system likes to see it defined.

AddReference "Microsoft.Office.Interop.Excel.dll"
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Excel
Sub Main
	'Dim oExcel As Excel.Application = New Excel.Application
	Dim oExcel As Excel.Application = New Excel.ApplicationClass
	'Dim oExcel As Excel.Application = CreateObject("Excel.Application")
	
	oExcel.Visible = True
	oExcel.DisplayAlerts = True
	
	Dim oWB As Workbook
	If oExcel.Workbooks.Count = 0 Then
		oWB = oExcel.Workbooks.Add
	Else
		oWB = oExcel.ActiveWorkbook
		'oWB = oExcel.Workbooks.Item(1)
	End If
	oWB.Activate
	
	Dim oWS As Worksheet
	If oWB.Worksheets.Count = 0 Then
		oWS = oWB.Worksheets.Add
	Else
		oWS = oWB.Worksheets.Item(1)
	End If
	oWS.Activate
	
	oWS.Cells(1,1) = "ABC" ' (same as Cell A1 or the cell at Row 1 & Column 1)
	oWS.Range("A2").Value = "DEF"
	
	MsgBox("TypeName(oExcel) = " & TypeName(oExcel), vbInformation, "")
	
	oExcel = Nothing
End Sub

Wesley Crihfield

(Not an Autodesk Employee)

t_fransman · ‎02-09-2022

why is this '-ed out

	Dim oWB As Workbook
	If oExcel.Workbooks.Count = 0 Then
		oWB = oExcel.Workbooks.Add
	Else
		oWB = oExcel.ActiveWorkbook
		'oWB = oExcel.Workbooks.Item(1)

am i supposed to try that on or off and swap With 'oWB = oExcel..ActiveWorkbook

WCrihfield · ‎02-09-2022

It's simply an additional way to get an existing Workbook. I often already have Excel open, so I sometimes use GetObject() instead of (or before) New or CreateObject(), and there may be multiple Workbooks already open within the Excel application. And it may depend on your settings as to whether Excel will have a new or pre-existing Workbook available to work with when you simply start an instance of the application. There are several ways to specify which Workbook you want to work with. If it is not already open, then of course you can use either the Add or Open methods to create/get it, but if it is already open, you also still have multiple options to choose from. If it is the only one, the 'ActiveWorkbook' is just fine. If there are multiple open, you can use the Workbooks.Item() and either specify an Index integer or its name to get the one you want. That's all. The options can seem almost endless once you've gotten into it a bit.

Wesley Crihfield

(Not an Autodesk Employee)

t_fransman · ‎02-09-2022

AddReference "Microsoft.Office.Interop.Excel.dll" Imports Microsoft.Office.Interop Imports Microsoft.Office.Interop.Excel Sub Main If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then MsgBox("A Drawing Document must be active for this rule to work. Exiting.", vbCritical, "") Exit Sub End If Dim oDDoc As DrawingDocument = ThisDoc.Document oExcelFile = ThisDoc.ChangeExtension(".xls") If System.IO.File.Exists(oExcelFile) Then oAns = MsgBox("The Excel file already exists." & vbCrLf & _ oExcelFile & vbCrLf & _ "Do you want to overwrite the file?", vbYesNo + vbQuestion + vbDefaultButton1, "File Exists") If oAns = vbYes Then System.IO.File.Delete(oExcelFile) End If End If 'run our custom Sub routine below to export all parts lists ExportAllPartsLists(oDDoc, oExcelFile) Dim oRevLevel As Integer If oDDoc.Sheets(1).RevisionTables.Count > 0 Then oRevLevel = oDDoc.Sheets(1).RevisionTables(1).RevisionTableRows.Count End If 'run our custom Sub routine below to format exported data FormatExportedData(oExcelFile, oRevLevel) End Sub Sub ExportAllPartsLists(oDrawing As DrawingDocument, oExcelFile As String) oSheetCount = oDrawing.Sheets.Count oOptions = ThisApplication.TransientObjects.CreateNameValueMap For Each oSheet As Inventor.Sheet In oDrawing.Sheets If oSheet.PartsLists.Count = 0 Then Continue For 'skip to next oSheet oSheetNumber = oSheet.Name.Split(":")(1) 'gets the Integer after the : at the end ThisApplication.StatusBarText = "Exporting Sheet " & oSheetNumber & " of " & oSheetCount & " Please Wait!" oPList = oSheet.PartsLists.Item(1) oOptions.Clear 'oOptions.Value("Template") = ThisDoc.Path & "\BOM Template.xlsx" 'oOptions.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION" oOptions.Value("StartingCell") = "A2" oOptions.Value("TableName") = "BOM-Sheet " & oSheetNumber oOptions.Value("IncludeTitle") = False oOptions.Value("AutoFitColumnWidth") = True Try oPList.Export(oExcelFile, PartsListFileFormatEnum.kMicrosoftExcel, oOptions) Catch oEx As Exception MsgBox("Error trying to export PartsList on sheet " & oSheetNumber & "." & vbCrLf & _ oEx.Message & vbCrLf & oEx.StackTrace, vbExclamation, "Export Error") End Try Next End Sub Sub FormatExportedData(oExcelFile As String, oRevLevel As Integer) 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 Dim oExcel As Excel.Application = CreateObject("Excel.Application") 'Dim oExcel As Excel.Application = New Excel.ApplicationClass ' Dim oExcel As Excel.Application = New Excel.ApplicationClass 'Dim oExcelApp As Excel.Application ' = New Excel.Application ExcelApp = CreateObject("Excel.Application") ExcelApp.Visible = False ExcelApp.DisplayAlerts = False ExcelWorkbook = ExcelApp.Workbooks.Open(oExcelFile) Dim SheetCount As Integer = 1 Dim Fail As Boolean Dim DropCount As Integer For Each sh As Excel.Worksheet 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 Dim RoutingSheet As Excel.Worksheet 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 Dim PropertiesSheet As Excel.Worksheet 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 = oRevLevel 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 End Sub

t_fransman · ‎02-09-2022

I added there in so I could try them all. Not sure what id did but now it only exports drawing sheet 10 to a tab

Dim oExcel As Excel.Application = CreateObject("Excel.Application")
'Dim oExcel As Excel.Application = New Excel.ApplicationClass
' Dim oExcel As Excel.Application = New Excel.ApplicationClass
'Dim oExcelApp As Excel.Application ' = New Excel.Application

t_fransman · ‎02-09-2022

Added it back a as a txt so you could see where i tried to apply it. All worked except only got sheet 10 now

t_fransman · ‎02-09-2022

Community

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

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

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