How to Create a Macro to Open .sldlfp Files from a User-Selected Folder and Write a Custom Property?

Hi everyone,

I’m trying to create a SolidWorks VBA macro that does the following:

  • Asks the user to select a folder.
    Opens all .sldlfp (library feature part) files found in that folder.
    Adds a custom property called “Description”
    Sets the value of “Descriptiono” to the file name .
    Saves and closes the file.

I’ve tried using OpenDoc6(), but I’m getting type mismatch errors when trying to open .sldlfp files. What is the correct document type to use for opening these files in SolidWorks VBA?

I’d appreciate any help or example code to accomplish this.

Thanks in advance!

OpenDoc6 should work fine provided you have the file path correct, and type as part. Share your complete codes to check.

I tried this code. But apparently, openDoc6 not opens sldlfp, only part files.

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim fso As Object
Dim folderPath As String

Sub AddDescriptionProperty()
Set swApp = Application.SldWorks
Set fso = CreateObject(“Scripting.FileSystemObject”)

’ Folder navigation
folderPath = InputBox(“Digite o caminho da pasta com os arquivos do SolidWorks:”, “Selecionar Pasta”)

’ Check if the path exists
If folderPath = “” Or Not fso.FolderExists(folderPath) Then
MsgBox “Pasta inválida ou não selecionada!”, vbExclamation
Exit Sub
End If

’ Files in the folder
Dim file As Object
Dim folder As Object
Set folder = fso.GetFolder(folderPath)

Dim fileExt As String
For Each file In folder.Files
fileExt = LCase(Right(file.Name, 6))
If fileExt = “sldlfp” Then
ProcessFile file.Path
End If
Next file

MsgBox “Custom property added successfully!”, vbInformation
End Sub

Sub ProcessFile(filePath As String)
Dim errors As Long, warnings As Long
Dim docType As Integer

’ Type of doc
If Right(filePath, 6) = “sldprt” Or Right(filePath, 7) = “sldlfp” Then
docType = swDocPART
Else
Exit Sub
End If

’ Open files in SolidWorks
Set swModel = swApp.OpenDoc6(filePath, docType, swOpenDocOptions_Silent, “”, errors, warnings)

'Check if files were opened
If Not swModel Is Nothing Then
Set swCustPropMgr = swModel.Extension.CustomPropertyManager(“”)

’ If SLDLFP, access the active configuration properties
If Right(filePath, 7) = “sldlfp” Then
Set swConfigMgr = swModel.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
If Not swConfig Is Nothing Then
Set swCustPropMgr = swConfig.CustomPropertyManager
End If
End If

’ Add the custom property
If Not swCustPropMgr Is Nothing Then
Dim result As Variant
result = swCustPropMgr.Set(“DESCRIÇÃO”, “$PRP:“SW-File Name””)
Else
MsgBox "Não foi possível acessar as propriedades de " & filePath, vbExclamation
End If

’ Rebuild
swModel.ForceRebuild3 False
swModel.Save
swApp.CloseDoc swModel.GetTitle
Else
MsgBox "Error: " & filePath, vbExclamation
End If
End Sub

I made some minor changes in your codes (made them bold in the codes lines below), and they work fine for me,

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim fso As Object
Dim folderPath As String

Sub Main()

Set swApp = Application.SldWorks
Set fso = CreateObject(“Scripting.FileSystemObject”)

’ Folder navigation
folderPath = InputBox(“Digite o caminho da pasta com os arquivos do SolidWorks:”, “Selecionar Pasta”) ’

’ Check if the path exists
If folderPath = “” Or Not fso.FolderExists(folderPath) Then
MsgBox “Pasta inválida ou não selecionada!”, vbExclamation
Exit Sub
End If

’ Files in the folder
Dim file As Object
Dim folder As Object
Set folder = fso.GetFolder(folderPath)

Dim fileExt As String
For Each file In folder.Files
fileExt = UCase(Right(file.Name, 6))
If fileExt = “SLDLFP” Then
ProcessFile file.Path
End If
Next file

MsgBox “Custom property added successfully!”, vbInformation
End Sub

Sub ProcessFile(filePath As String)
Dim errors As Long, warnings As Long
Dim docType As Integer

’ Type of doc
If UCase(Right(filePath, 6)) = “SLDPRT” Or UCase(Right(filePath, 6)) = “SLDLFP” Then
docType = swDocPART
Else
Exit Sub
End If

’ Open files in SolidWorks
Set swModel = swApp.OpenDoc6(filePath, docType, swOpenDocOptions_Silent, “”, errors, warnings)


'Check if files were opened
If Not swModel Is Nothing Then
Set swCustPropMgr = swModel.Extension.CustomPropertyManager(“”)

’ If SLDLFP, access the active configuration properties
If UCase(Right(filePath, 7)) = “SLDLFP” Then
Set swConfigMgr = swModel.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
If Not swConfig Is Nothing Then
Set swCustPropMgr = swConfig.CustomPropertyManager
End If
End If

’ Add the custom property
If Not swCustPropMgr Is Nothing Then
Dim result As Variant
result = swCustPropMgr.Set(“DESCRIÇÃO”, “$PRP:” & Chr(34) & “SW-File Name” & Chr(34))
Else
MsgBox "Não foi possível acessar as propriedades de " & filePath, vbExclamation
End If

’ Rebuild
swModel.ForceRebuild3 False
swModel.Save
swApp.CloseDoc swModel.GetTitle
Else
MsgBox "Error: " & filePath, vbExclamation
End If
End Sub

It is very strange because the macro works without any error but the custom property isn’t create.
What SOLIDWORKS version did you use?

This is a screenshot of the Custom Property window after the macro. I’m unable to found the reason why the property ‘Descrição’ is not created.
Screenshot.png

This help example shows using add3 instead of set to create a new custom property.

Add and Get Custom Properties Example (VBA)

Deepak Gupta is a legend! Thanks a lot!!!
SPerman thank you as welll!

I change the code that Gupta sent me and use the add3.
The macro worked very well!

Thanks guys!!!

You are using swCustPropMgr.Set to change the property value, and swCustPropMgr.Set works for an existing property. If the desired property does not exists, then there would be no property added. So using swCustPropMgr.Add3 like @SPerman mentioned, will work in any conditions.

1 Like