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