- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
No problem, I checked it again and reproduced the issue. It means that the title of your partslist title is the same. I assumed from your screenshots that your titles where manually changed. I added a new check in the code.
Dim oDrawDoc As DrawingDocument = ThisDrawing.Document
Dim oSheets As Sheets = oDrawDoc.Sheets
'get the path and name of the drawing file
Dim fileName = ThisDoc.PathAndFileName(False) & ".xlsx"
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 oParents, otitles As New ArrayList
Dim startRow = 1
Dim includeTitle = False
Dim PartsListNumber = 1
Dim oPartslist As PartsList
For Each sheet As Sheet In oSheets 'Find every sheet in the drawing
For Each oPartslist In Sheet.PartsLists 'Find every partslist on the sheet
If Not oParents.Contains(oPartslist.ReferencedDocumentDescriptor.FullDocumentName) Then
oParents.Add(oPartslist.ReferencedDocumentDescriptor.FullDocumentName)
ThisApplication.StatusBarText = "Exporting Sheet " & Sheet.Name & " of " & oSheets.Count & " Please Wait!"
' 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(all columns need to be in the partslist)
'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
If Not otitles.Contains(oPartslist.Title) Then
otitles.Add(oPartslist.Title)
oOptions.Value("TableName") = oPartslist.Title
Else
oOptions.Value("TableName") = oPartslist.Title & PartsListNumber
End If
'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)
PartsListNumber = PartsListNumber + 1
Else
Logger.Info(Sheet.Name & ": there is already a partslist exported for file reference " & oPartslist.ReferencedDocumentDescriptor.FullDocumentName)
End If
Next
Next
Dim Complete = MessageBox.Show("All Done with Partslist Export" & vbCr & vbCr & fileName & vbCr & vbCr _
& "Do you want to open the file?", "Part List Export", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
If Complete = vbYes Then
ThisDoc.Launch(fileName)
Else
Return
End If