Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
theo.bot
in reply to: haitam.moslemane

@haitam.moslemane 

 

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