I am working on a macro to traverse an assembly of parts (with different configurations) and return the configuration specific property "Description" for each part in the assembly. I am not looking for the configuration name, but rather the Configuration Specific Property for that configuration.

I believe I am close (code below), but the routine continues to return the first Description for all subsequent instances of the same part instead of looking up the configuration specific property for that specific configuration.

Below is a screenshot of the assembly tree with the corresponding output from the macro.  You will notice the order does not match, but more importantly the description is repeated instead of incremented for each different

configuration.

Would anybody be willing to take a look and help me identify where I am going wrong?

Any advice or assistance would be greatly appreciated.

Thank you in advance.

Option Explicit

Dim swApp As SldWorks.SldWorks 

Sub main()
Dim swModel As ModelDoc2 
Dim vComps As Variant 
Dim swComp As SldWorks.Component2 
Dim swAssy As SldWorks.AssemblyDoc
Dim i As Integer
Dim sPartDesc() As String
Dim intNumberOfParts As Integer
Dim sOutMsg As String
Dim sFileName As String

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

If swModel.GetType = swDocASSEMBLY Then 
      Set swAssy = swModel 
      vComps = swAssy.GetComponents(False) 
      intNumberOfParts = UBound(vComps) 
      ReDim sPartDesc(intNumberOfParts)
      For i = 0 To UBound(vComps) 
            Set swComp = vComps(i) 
            Set swModel = swComp.GetModelDoc2 
            sFileName = swComp.Name
            sPartDesc(i) = GetComponentName(swModel) 
            sOutMsg = sOutMsg & Chr(13) & sFileName & ": " & sPartDesc(i)
      Next i
      MsgBox (sOutMsg)
End If

End Sub

Function GetComponentName(swModel As SldWorks.ModelDoc2) As String
Dim cusPropMgr As CustomPropertyManager 
Dim lRetVal As Long
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim config As SldWorks.Configuration
Dim ResolvedValOut As String
Dim nNbrProps As Long
Dim j As Long
Dim custPropType As Long
Dim sActiveDescripiton As String

GetComponentName = "None"

Set config = swModel.GetActiveConfiguration
Set cusPropMgr = config.CustomPropertyManager

' Get the number of custom properties for this configuration
nNbrProps = cusPropMgr.Count
' Get the names of the custom properties
lRetVal = cusPropMgr.GetAll2(vPropNames, vPropTypes, vPropValues, resolved)

' For each custom property, look for "Description" and return that value
For j = 0 To nNbrProps - 1
      custPropType = cusPropMgr.GetType2(vPropNames(j))
      If vPropNames(j) = "Description" Then
            GetComponentName = vPropValues(j)
            j = nNbrProps
      End If
Next j
End Function