Recover value file extension

Out of category
1

 Hello everyone.
I have a small level in VBA. I got a code that I modified following your advice on this forum.
Starting from an assembly, it allows you to export the bill of materials to a sheet .xls
It works perfectly but I would like to add the ability to retrieve the extension of the files in the column: J. 
The variable that allows you to retrieve the extension is as follows: Right(docfilename , 6)
How do I integrate this variable into my program?

 

Sub main()

Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim wbk As Excel.Workbook
Dim sht As Excel.Worksheet

With xlApp
    . Visible = True
    Set wbk = . Workbooks.Add
    Set sht = wbk. ActiveSheet
End With

Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim swModelDocExt           As SldWorks.ModelDocExtension
Dim swBOMAnnotation         As SldWorks.BomTableAnnotation
Dim swBOMFeature            As SldWorks.BomFeature
Dim boolstatus              As Boolean
Dim BomType                 As Long
Dim Configuration           As String
Dim TemplateName            As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension

TemplateName = "M:\DATABASE\TEMPLATES\05-Model of nomenclature\GP_ASM_Nomenclature BOS.sldbomtbt"
BomType = swBomType_Indented
Configuration = swApp.GetActiveConfigurationName(swModel.GetPathName)
MsgBox Configuration
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, True)
Set swBOMFeature = swBOMAnnotation.BomFeature

swModel.ForceRebuild3 True

Dim NumCol As Long
Dim NumRow As Long
Dim I As Long
Sun J As Long

NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount

For I = 0 To NumRow
    For J = 0 TB NumCol
        Sht. Cells(I + 1, J + 1). Value = swBOMAnnotation.Text(I, J)
    Next J
Next I

boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete

Dim Path As String
path = "C:\temp\BOS.xlsx"

With xlApp
    wbk. SaveAs path
    wbk. Close
    . Quit
End With

End Sub

2

Hello

You should see with the following API help code snippet: http://help.solidworks.com/2019/english/api/sldworksapi/Get_Components_in_Each_BOM_Table_Row_VB.htm

 

 

3

If I understand correctly, your program creates a nomenclature, then goes through it to retrieve the content.

You should have a screenshot of your nomenclature (the list of columns).

Personally, I'll add a column in the BOM that retrieves the full name of the file.
We then have 2 possibilities:
- Treat the cell with VBA;
- Use XL features.

In VBA, you do a second loop with something like this:
Sht. Cells(I + 1, colonne_nom_fichier). Value = Right( sht. Cells(I + 1, colonne_nom_fichier). Value, 6)

4

The idea of adding a column in the BOM that retrieves the full name of the file is a good one.

Unfortunately, SolidWorks does not include the option to retrieve the file name and extension.

5

Since it is possible to right-click to open the file of a line of the BOM, you can perhaps retrieve the name in this way (by simulating an opening)?

The image is not legible (that's the problem with this forum), it must be attached.

6

PCs


capture.jpg
7

Hello

The link I put allows you to loop in the BOM to retrieve the full path (with extension).

8

Cyril. Thank you for the links. I can't launch this program, it puts an error message on the 7th line.

How did you manage to test it? I think I didn't make a mistake but I can't figure out what :/ 

9

Hello

I just threw on a plan containing a nomenclature. Where does it plant? (7th line I'm not sure I have the right one)

10

In my case, nothing happens :O

Could you make a screenshot of the results obtained?

 

-----------------------------------

Prerequisites:
' 1. Open public_documents \samples\tutorial\assemblyvisual\food_processor.sldasm.
'2. Make a drawing from the assembly.
'3. Select Insert> Tables> Bill of Materials .
'4. Make sure that the Parts Only in BOM Type option is selected.
'5. Make sure that the Show configurations in the same room as separate items option 
" in Part Configuration Grouping is selected.
'6.  Click OK .
'7. Click anywhere in the drawing to insert the BOM table.
'
' Postconditions:
'1.BOM Functionality1 .
'2. Gets the default configuration . 
'3. Processes the BOM table for the default configuration . 
'4. Examine the Execution window.
'
' NOTE : As the template is used elsewhere, do not save the changes

11

Hello

Attached is a screenshot.


macro_sw_get_coponent_in_bom.jpg
12

Thank you. The result is in the execution part. How to do it, go to the xls sheet?

13

Hello

Below is the integration of the sample API. I didn't put a check on the docfilename variable being empty.

Dim vPtArr As Variant
Dim swComp As Object
Dim pt As Object
Dim compPath As String
Dim docfilename As String

Sub main()

Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim wbk As Excel.Workbook
Dim sht As Excel.Worksheet

With xlApp
    .Visible = True
    Set wbk = .Workbooks.Add
    Set sht = wbk.ActiveSheet
End With

Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim swModelDocExt           As SldWorks.ModelDocExtension
Dim swBOMAnnotation         As SldWorks.BomTableAnnotation
Dim swBOMFeature            As SldWorks.BomFeature
Dim boolstatus              As Boolean
Dim BomType                 As Long
Dim Configuration           As String
Dim TemplateName            As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension

TemplateName = "M:\DATABASE\MODELES\05-Model de nomenclature\GP_ASM_Nomenclature BOS.sldbomtbt"
BomType = swBomType_Indented
Configuration = swApp.GetActiveConfigurationName(swModel.GetPathName)
MsgBox Configuration
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, True)
Set swBOMFeature = swBOMAnnotation.BomFeature

swModel.ForceRebuild3 True

Dim NumCol As Long
Dim NumRow As Long
Dim I As Long
Dim J As Long

NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount

For I = 0 To NumRow
    vPtArr = swBOMAnnotation.GetComponents2(I, Configuration)
    If (Not IsEmpty(vPtArr)) Then
        For K = 0 To UBound(vPtArr)
            Set pt = vPtArr(K)
            Set swComp = pt
            If Not swComp Is Nothing Then
                docfilename = swComp.GetPathName
            End If
        Next K
    End If
    For J = 0 To NumCol
        sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
    Next J
    If I > 0 Then
        sht.Cells(I + 1, J).Value = Right(docfilename, 6)
    End If
Next I

boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete

Dim chemin As String
chemin = "C:\temp\BOS.xlsx"

With xlApp
    wbk.SaveAs chemin
    wbk.Close
    .Quit
End With

End Sub

 

3 Likes
14

Thanks for the code:)

I just have a small problem with Li13, Col 1 compilation error

15

You should take a screenshot of the error message because Li13,Col1 is an empty line for me.

16

Erratum :) Li 8, Col 1


capture.jpg
17

This is not the line where the problem is but where the cursor is.

So I'll say that Dim K as long is missing

Otherwise look in the references (tools > References) and it should look like the screenshot attached to the version number.


references_vba.jpg
1 Like
18

Cyril.f Bravo and thank you:D

This actually came from the option: Microsoft Excel 16.0 Object Library