Found this great macro on the forums a year or so ago. Worked great on 2014. It reorders the custom properties in our older files so that they follow the same order as our templates. Now when I run it nothing happens, no errors or anything. All our other macros run just fine after the upgrade to 2016, just not this one.
The references as they currently stand:
The macro:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim vCustPropNames As Variant
Dim vCustPropTypes As Variant
Dim vCustPropVals As Variant
Dim colCurrent As New Collection
Dim colSkip As New Collection
Dim colMain As New Collection
Dim bSkip As Boolean
Dim bDefaultDataType As Boolean
Sub Main()
Dim CustProp As CustProp
Dim curCustProp As CustProp
Dim i As Integer
'Clean up the collections.
Set colCurrent = Nothing
Set colSkip = Nothing
Set colMain = Nothing
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then Exit Sub 'Exit macro since no document is open.
Set swCustPropMgr = swModel.Extension.CustomPropertyManager(Empty)
swCustPropMgr.GetAll vCustPropNames, vCustPropTypes, vCustPropVals
If Not IsEmpty(vCustPropNames) Then
For i = 0 To UBound(vCustPropNames) 'Get all current custom properties from the file. Add them to collection colCurrent
Set CustProp = New CustProp
CustProp.cpName = vCustPropNames(i)
CustProp.cpType = vCustPropTypes(i)
CustProp.cpValue = vCustPropVals(i)
colCurrent.Add CustProp
Next
End If
AddMainCustProps 'Add all "main" custom properties to collection colMain with method AddMainCustProps.
'Edit (Sub) AddMainCustProps if needed.
' Use Default Data Types for custom properties that exist in file?
' If bDefaultDatatype is set to True. Means that the macro
' strictly use the stated default data type in AddMainCustProps for the main custom properties.
' This may give run-time error if the macro is trying to convert text/number to date etc.
'
' If bDefaultDatatype is set to False. The macro will keep the data type
' of already existing main custom properties.
bDefaultDataType = False
Do While colCurrent.Count <> 0
For i = 1 To colMain.Count
Set CustProp = colMain.Item(i) 'Set CustProp to the object in collection colMain
Set curCustProp = colCurrent.Item(1) 'Set curCustProp to the object in collection colCurrent
If CustProp.cpName = curCustProp.cpName Then 'If statment to get current data if any was present.
CustProp.cpValue = curCustProp.cpValue 'Push value from current custom property object to main custom property object
If bDefaultDataType = False Then 'If False, keep current data type.
CustProp.cpType = curCustProp.cpType
End If
colCurrent.Remove 1
bSkip = False
If colCurrent.Count = 0 Then Exit For 'Exit For statement if the colCollection runs out of objects.
Else
bSkip = True 'bSkip = True If the custom property was NOT in the colMain collection.
End If
Next
If bSkip = True Then 'This is a custom property that was not found to be in the colMain collection.
colSkip.Add colCurrent.Item(1)
colCurrent.Remove 1
End If
Loop
If Not IsEmpty(vCustPropNames) Then
For i = 0 To UBound(vCustPropNames) 'Delete all current custom properties in the file.
swCustPropMgr.Delete vCustPropNames(i)
Next i
End If
For Each CustProp In colMain 'Add all main custom properties.
swCustPropMgr.Add2 CustProp.cpName, CustProp.cpType, CustProp.cpValue
Next
For Each CustProp In colSkip 'Add back all non-main custom properties.
swCustPropMgr.Add2 CustProp.cpName, CustProp.cpType, CustProp.cpValue
Next
swCustPropMgr.GetAll vCustPropNames, vCustPropTypes, vCustPropVals
For i = 0 To UBound(vCustPropNames)
'If a custom property is of Date type and empty (shorter than 6 chars) a message will be prompted the user.
'If a custom property of Date type is empty (or invalid) the document will fail to save.
'Futher checks of custom property data may be added here with other If statements.
If vCustPropTypes(i) = SwDmCustomInfoType.swDmCustomInfoDate And Len(vCustPropVals(i)) < 6 Then
swApp.SendMsgToUser2 "Custom property: " & vCustPropNames(i) & vbNewLine & vbNewLine & _
"Is of Date format but seems to be empty." & vbNewLine & _
"It is most likely that the document will fail to save." & vbNewLine & vbNewLine & _
"Please check the stated custom property if the documents failes to save.", 1, 2
End If
Next
End Sub
Sub AddMainCustProps()
' Does it look like a mess?! Do not worry...
' Change order, add or remove lines as you like. The order is the order that will be in the custom property page (File->Properties) in SW.
'
' Syntax: AddCustProp "Name of custom property", Default data type, "Default value"
'
' Data types:
' swCustomInfoType_e.swCustomInfoDate
' swCustomInfoType_e.swCustomInfoDouble
' swCustomInfoType_e.swCustomInfoNumber
' swCustomInfoType_e.swCustomInfoText
' swCustomInfoType_e.swCustomInfoUnknown
' swCustomInfoType_e.swCustomInfoYesOrNo
AddCustProp "PartNo", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "OldPartNumber", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "Revision", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "Project", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "Title", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "Description", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "StockSize", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "PartDetails", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "Material", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "Weight", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "Component", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "Orientation", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "Class", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "CharacteristicSize", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "AssemblyType", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "Customer", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "DrawnBy", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "DrawnDate", swCustomInfoType_e.swCustomInfoDate, ""
End Sub
Sub AddCustProp(cpName As String, cpType As Long, cpValue As Variant)
Dim CustProp As CustProp
Set CustProp = New CustProp
CustProp.cpName = cpName
CustProp.cpType = cpType
CustProp.cpValue = cpValue
colMain.Add CustProp
End Sub