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 

 

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