Hi

I created maro to insert values into all parts of the assembly. After entering the values "save all". Everything worked great in version 2017 and 2018, but 2021 not. After reopening assembly the values are gone. Any suggestions?

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim vComps As Variant
Dim swComp As SldWorks.Component2
Dim swAssy As SldWorks.AssemblyDoc
Dim i As Integer
Dim wo_num As String
Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
wo_num = InputBox("Project Name")
updateProperty1 swModel, wo_num

If swModel.GetType = swDocASSEMBLY Then
    Set swAssy = swModel
    vComps = swAssy.GetComponents(False)
    For i = 0 To UBound(vComps)
        Set swComp = vComps(i)
        If swComp.GetSuppression = swComponentFullyResolved Then
            Set swModel = swComp.GetModelDoc2
            updateProperty1 swModel, wo_num
        Else
              End If
          Next i
End If

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
wo_num = InputBox("Cislo Dilu: Teil-Nr")
updateProperty2 swModel, wo_num
  
If swModel.GetType = swDocASSEMBLY Then
    Set swAssy = swModel
    vComps = swAssy.GetComponents(False)
    For i = 0 To UBound(vComps)
        Set swComp = vComps(i)
        If swComp.GetSuppression = swComponentFullyResolved Then
            Set swModel = swComp.GetModelDoc2
            updateProperty2 swModel, wo_num
        Else
             End If
       Next i
End I

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
wo_num = InputBox("Nazev Dilu: Teil-Benennung")
updateProperty3 swModel, wo_num
  
If swModel.GetType = swDocASSEMBLY Then
    Set swAssy = swModel
    vComps = swAssy.GetComponents(False)
    For i = 0 To UBound(vComps)
        Set swComp = vComps(i)
        If swComp.GetSuppression = swComponentFullyResolved Then
            Set swModel = swComp.GetModelDoc2
            updateProperty3 swModel, wo_num
        Else
          End If
         Next i
End If
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
wo_num = InputBox("wzg Bennenung")
updateProperty4 swModel, wo_num
  
If swModel.GetType = swDocASSEMBLY Then
    Set swAssy = swModel
    vComps = swAssy.GetComponents(False)
    For i = 0 To UBound(vComps)
        Set swComp = vComps(i)
        If swComp.GetSuppression = swComponentFullyResolved Then
            Set swModel = swComp.GetModelDoc2
            updateProperty4 swModel, wo_num
        Else
     End If
Next i
End If
End Sub

Function updateProperty1(swModel As SldWorks.ModelDoc2, mValue As String) As Boolean
Dim cpm As CustomPropertyManager
Set cpm = swModel.Extension.CustomPropertyManager("")
cpm.Add3 "Project Name", swCustomInfoText, mValue, 1
End Function

Function updateProperty2(swModel As SldWorks.ModelDoc2, mValue As String) As Boolean
Dim cpm As CustomPropertyManager
Set cpm = swModel.Extension.CustomPropertyManager("")
cpm.Add3 "Cislo Dilu", swCustomInfoText, mValue, 1

End Function

Function updateProperty3(swModel As SldWorks.ModelDoc2, mValue As String) As Boolean
Dim cpm As CustomPropertyManager
Set cpm = swModel.Extension.CustomPropertyManager("")
cpm.Add3 "Nazev Dilu", swCustomInfoText, mValue, 1
End Function

Function updateProperty4(swModel As SldWorks.ModelDoc2, mValue As String) As Boolean
Dim cpm As CustomPropertyManager
Set cpm = swModel.Extension.CustomPropertyManager("")
cpm.Add3 "wzg Bennenung", swCustomInfoText, mValue, 1
End Function

​​​​​​​