Hi. Please see this other thread with a viable solution posted.
https://forums.autodesk.com/t5/inventor-customization/thisbom-export-column-order-problem/m-p/490203...
AddReference "Microsoft.Office.Interop.Excel" 'To use excel
Imports System.Windows.Forms
Imports System.IO
Imports Microsoft.Office.Interop.Excel 'To use excel
Sub Main()
Dim oDoc As AssemblyDocument = ThisApplication.ActiveDocument
'Dim oPath As String
'oPath = oFolderDlg
'oFileName = oPath & "Bruce.xml"
ExportBOM(oDoc)
End Sub
Private BOMCustomizationFile As String = "C:\CustFile.xml"
Private excelApp As Microsoft.Office.Interop.Excel.Application
Private xlws As Worksheet
Sub ExportBOM(oDoc As Document)
'File Path Creation/Processing
'Note, the following line will cause an error if the document is not saved.
Dim oExportPath As String = System.IO.Path.GetDirectoryName(oDoc.FullFileName) & "\BOM\"
Dim oExportName As String = oExportPath & System.IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName) 'without extension'get BOM Target folder path
If Not System.IO.Directory.Exists(oExportPath) Then: System.IO.Directory.CreateDirectory(oExportPath): End If
If Dir(oExportName & ".xlsx") <> "" Then
Kill (oExportName & ".xlsx")
End If
'Inventor BOM Processing
Dim oBOM As BOM = oDoc.ComponentDefinition.BOM
oBOM.ImportBOMCustomization(BOMCustomizationFile)
oBOM.StructuredViewEnabled = True
oBOM.StructuredViewFirstLevelOnly = False
Dim oStructuredBOMView As BOMView
oStructuredBOMView = oBOM.BOMViews.Item("Structured")
oStructuredBOMView.Export (oExportName & ".xlsx", kMicrosoftExcelFormat)
'Excel processing
excelApp = CreateObject("Excel.Application")
excelApp.Visible = True
excelApp.DisplayAlerts = False
wb = excelApp.Workbooks.Open(oExportName & ".xlsx")
xlws = wb.Worksheets(1)
Call ReorderXLBOM()
excelApp.Columns.AutoFit
excelApp = Nothing
End Sub
Private Sub ReorderXLBOM()
Dim ndx As Integer
Dim Found As Range
Dim counter As Integer = 1
Dim arrColOrder() As String = {"Item", "QTY", "Part Number", "Description", "Stock Number"}
'arrColOrder = Array("Item", "QTY", "Part Number", "Description", "Stock Number")
On Error Resume Next
For ndx = LBound(arrColOrder) To UBound(arrColOrder)
'Set Found = xlws.Rows("1:1").Find(arrColOrder(ndx),, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
Found = xlws.Rows("1:1").Find(arrColOrder(ndx), , -4163, 1, 2, 1, False)
If Err.Number <> 0 Then
MsgBox ("Error With Excel FIND function: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
Err.Clear
End If
If Not Found Is Nothing Then
If Found.Column <> counter Then
Found.EntireColumn.Cut
xlws.Columns(counter).Insert(-4161)
excelApp.CutCopyMode = False
End If
counter = counter + 1
End If
Next
If Err.Number <> 0 Then
MsgBox ("Reorder Columns Rule Error: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
Err.Clear
End If
End Sub
Public Function oFolderDlg
Dim dialog = New FolderBrowserDialog()
' dialog.SelectedPath = Application.StartupPath
dialog.ShowNewFolderButton = True
' openFileDialog1.InitialDirectory
If DialogResult.OK = dialog.ShowDialog() Then
oPath = dialog.SelectedPath
Else
MsgBox("No File Selected. Aborting Rule")
oPath = ""
End If
Return oPath
End Function
--------------------------------------
Did you find this reply helpful ? If so please use the 'Accept as Solution' or 'Like' button below.