Use Excel API to export PartsList content

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:\temp\test.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:\temp\test2.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:\temp\test.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:\temp\test2.xlsm")

' Close excel
Call oExcel.Quit