Use Excel API to export PartsList content

<?xml encoding=”UTF-8″>By Adam Nagy

In case PartsList.Export() does not do exactly what you need, you can take full control of what gets exported and how by using the Excel API directly. 

The following sample exports the content of the first PartsList of the active sheet. 

VBA

Sub ExportPartsListContent()
Dim oExcel As Object
Set oExcel = CreateObject("Excel.Application")
' For debugging
'oExcel.Visible = True
Dim oWB As Object
Set oWB = oExcel.Workbooks.Open("C:temptest.xlsm")
Dim oWS As Object
Set oWS = oWB.ActiveSheet
Dim oDoc As DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oSheet As Sheet
Set oSheet = oDoc.ActiveSheet
' Export the first PartsList
Dim oPL As PartsList
Set oPL = oSheet.PartsLists(1)
' Starting cell position on the Excel sheet
Dim iRowStart As Integer: iRowStart = 1
Dim iColStart As Integer: iColStart = 1
' Export headers
Dim iRow As Integer: iRow = iRowStart
Dim iCol As Integer: iCol = iColStart
Dim oCol As PartsListColumn
For Each oCol In oPL.PartsListColumns
oWS.Cells(iRow, iCol).Value = oCol.Title
iCol = iCol + 1
Next
iRow = iRow + 1
' Export content
Dim oRow As PartsListRow
For Each oRow In oPL.PartsListRows
iCol = iColStart
Dim oCell As PartsListCell
For Each oCell In oRow
oWS.Cells(iRow, iCol).Value = oCell.Value
iCol = iCol + 1
Next
iRow = iRow + 1
Next
' Save it
' We disable the confirmation dialog
' in case the file already exists and
' needs to be overwritten
oExcel.DisplayAlerts = False
Call oWB.SaveAs("C:temptest2.xlsm")
' Close excel
Call oExcel.Quit
End Sub

iLogic

AddReference "Microsoft.Office.Interop.Excel"
Dim oExcel As New Microsoft.Office.Interop.Excel.Application
' For debugging
'oExcel.Visible = True
Dim oWB As Object
oWB = oExcel.Workbooks.Open("C:temptest.xlsm")
Dim oWS As Object
oWS = oWB.ActiveSheet
Dim oDoc As DrawingDocument
oDoc = ThisApplication.ActiveDocument
Dim oSheet As Sheet
oSheet = oDoc.ActiveSheet
' Export the first PartsList
Dim oPL As PartsList
oPL = oSheet.PartsLists(1)
' Starting cell position on the Excel sheet
Dim iRowStart As Integer: iRowStart = 1
Dim iColStart As Integer: iColStart = 1
' Export headers
Dim iRow As Integer: iRow = iRowStart
Dim iCol As Integer: iCol = iColStart
Dim oCol As PartsListColumn
For Each oCol In oPL.PartsListColumns
oWS.Cells(iRow, iCol).Value = oCol.Title
iCol = iCol + 1
Next
iRow = iRow + 1
' Export content
Dim oRow As PartsListRow
For Each oRow In oPL.PartsListRows
iCol = iColStart
Dim oCell As PartsListCell
For Each oCell In oRow
oWS.Cells(iRow, iCol).Value = oCell.Value
iCol = iCol + 1
Next
iRow = iRow + 1
Next
' Save it
' We disable the confirmation dialog
' in case the file already exists and
' needs to be overwritten
oExcel.DisplayAlerts = False
Call oWB.SaveAs("C:temptest2.xlsm")
' Close excel
Call oExcel.Quit