07-19-2022
11:37 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
07-19-2022
11:37 PM
1) In your rule you have defined the Table name yourself:
'specify the XLS tab name 'here the file name is used oOptions.Value("TableName") = "PartsList-" & PartsListNumber 'without extension
you need to replace this with the title value of your partslist
'specify the XLS tab name 'here the file name is used oOptions.Value("TableName") = oPartslist.Title
2) When you loop thru the partslists, you could check if there is already a partslist exported with the same file reference. create a new arraylist and check if the file reference already exists in the array. if not, add the file reference to arraylist and continue exporting.
Dim oParents As New ArrayList
If Not oParents.Contains(oPartslist.ReferencedDocumentDescriptor.FullDocumentName) Then oParents.Add(oPartslist.ReferencedDocumentDescriptor.FullDocumentName)
'excute export code ....
end if
Here's a new copy of your copy with these options:
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 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 oOptions.Value("TableName") = oPartslist.Title '"PartsList-" & PartsListNumber 'without extension '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