Macro to Add Prefix to All Custom Properties

I've been looking to build a macro that prefixes ALL custom properties

The purpose of this is related to receiving data from external sources, not wanting to loose them immediately but also not wanting overwrite them when added to PDM (eventually I would like to get this to run as a task in PDM on a transition).

By prefixing them with say "IMPORT-" it will mean the original properties are still in the file but also that they could be easily removed later using another macro if required (by search for properties that contain "IMPORT-").

There seem to be a few macros that get close put aren't quite doing what I'm after.

I've taken and started to modify a macro by ​ and got very close by just altering one line.

'Sort custom properites alphabetically

'Preconditions: part or assembly is open

'Written by Keith Rice

'CADSharp LLC

'www.cadsharp.com

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swCustPropMgr As SldWorks.CustomPropertyManager

Dim vCustPropNames As Variant

Dim vCustPropVals As Variant

Dim Current As New Collection

Dim Final As New Collection

Dim i As Integer

Dim blnFound As Boolean

Sub main()

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swCustPropMgr = swModel.Extension.CustomPropertyManager(Empty)

    swCustPropMgr.GetAll vCustPropNames, Empty, vCustPropVals

   

    'Put custom properties in a collection

    For i = 0 To UBound(vCustPropNames)

        Current.Add vCustPropNames(i)

        Current.Add vCustPropVals(i)

    Next i

   

    'Insertion sort

    Set Final = Nothing

    Do While Current.Count <> 0

        'First cust prop

        If Final.Count = 0 Then

            Final.Add Current.Item(1)

            Final.Add Current.Item(2)

            Current.Remove 1

            Current.Remove 1

        End If

       

        'Find place in Final collection

        blnFound = False

        For i = 1 To Final.Count Step 2

            If UCase(Current.Item(1)) < UCase(Final.Item(i)) Then

                Final.Add Current.Item(1), , i

                Final.Add Current.Item(2), , , i

                Current.Remove 1

                Current.Remove 1

                blnFound = True

                Exit For

            ElseIf Current.Item(1) = Final.Item(i) Then

                blnFound = True

            End If

        Next i

        If blnFound = False Then

            Final.Add Current.Item(1)

            Final.Add Current.Item(2)

            Current.Remove 1

            Current.Remove 1

        End If

    Loop

   

    'Delete and re-add custom properties

    For i = 0 To UBound(vCustPropNames)

        swCustPropMgr.Delete vCustPropNames(i)

    Next i

    For i = 1 To Final.Count Step 2

        swCustPropMgr.Add2 "IMPORT- " + Final.Item(i), swCustomInfoText, Final.Item(i + 1)

    Next i

End Sub

This works fine when the number of properties is 0 or greater than 1, then it doesn't work.

The really isn't much need to sort the properties in this application but I keeps things neat as its so close to working it seems a shame not to continue with this one.

I can write a case to to skip when 0.

What I don't understand is what you can do with a Ubound of 1? Do I need to make a special case for the instance where there is 1 custom property or can't this be altered to accommodate it?

SolidworksApi macros