How to set the class extension for an existing object class

Implementing a class extension is an ideal way to extend the default geodatabase behavior. This VBA script lets you set the class extension of an existing feature class or object class. To do this you must have already implemented a class extension suitable for the dataset. You should be cautious when using this script, since incorrectly applying class extensions can lead to unexpected behavior.

How to use

Paste the code into the ArcCatalog VBA environment.
Find the CLSID of the class extension you have developed. To do this search the registry for the name of your class and copy the CLSID to the clipboard.
In ArcCatalog, select the appropriate feature class or object class, then run the script
Paste in the CLSID, and press OK.
If you enter the string 'Nothing' instead of a CLSID, any current class extension will be cleared. If you press Cancel, the current CLSID will be shown.

[VBA]


        Public Sub SetClassExtension()
    
    Dim pGxApp As IGxApplication
    Set pGxApp = Application
    
    Dim pGxObject As IGxObject
    If (pGxObject Is Nothing) Then
        Set pGxObject = pGxApp.SelectedObject
    End If
    
    If Not (TypeOf pGxObject Is IGxDataset) Then Exit Sub
    
    Dim pGxDataset As IGxDataset
    Set pGxDataset = pGxObject ' QI
    
    If Not (TypeOf pGxDataset.Dataset Is IClass) Then Exit Sub
    
    Dim pClass As IClass
    Set pClass = pGxDataset.Dataset
    
    Dim strGUID As String
    strGUID = InputBox("Enter GUID", "Set class extension for " & pGxObject.Name)
    If Len(strGUID) <> 38 And UCase(strGUID) <> "NOTHING" Then
        ' Show the current extension
        Dim strCurrent As String
        If pClass.EXTCLSID Is Nothing Then
            strCurrent = "Current class extension is nothing"
        Else
            strCurrent = "Current class extension is: " & pClass.EXTCLSID
        End If
        MsgBox "No valid GUID entered." & vbNewLine & strCurrent
        Exit Sub
    End If
    
    
    Dim pUID As New UID
    If UCase(strGUID) = "NOTHING" Then
        Set pUID = Nothing
    Else
        pUID.Value = strGUID
    End If
    
    Dim pClassSchemaEdit As IClassSchemaEdit
    Set pClassSchemaEdit = pClass
    Dim pSchemaLock As ISchemaLock
    Set pSchemaLock = pClassSchemaEdit
    pSchemaLock.ChangeSchemaLock esriExclusiveSchemaLock
    pClassSchemaEdit.AlterClassExtensionCLSID pUID, Nothing
    pSchemaLock.ChangeSchemaLock esriSharedSchemaLock
    
    MsgBox "Class extension changed for " & pGxObject.Name
    
End Sub