Search code examples
dictionaryvbscriptenterprise-architectcreateobject

Class doesn't support Automation: 'CreateObject" when creating a Scripting.Dictionary object


I'm writing a VBScript in Enterprise Architect in order to generate an output of the message definitions in my model to Excel.

This script works just fine in most cases, but for one, rather large set of messages, it fails on creating a Scripting.Dictionary object.

One time if failed on

set m_properties = CreateObject("Scripting.Dictionary")

the second time a couple of lines futher

set attributesDictionary = CreateObject("Scripting.Dictionary")

The error I'm getting is:

EAWrappers.EATaggedValue error: Class doesn't support Automation: 'CreateObject', Line:62

The weird thing is that these lines have executed perfectly for thousands of times prior to failing.

Both times the error occurred on the same message object, but when I tried to run the script for this message alone, it ran without problems.

It makes me think there is some kind of limit on the number of Dictionary Objects I'm allowed to create or something like that so I only get the error with a large enough set of messages.

The complete script that fails below. For some reason it always fails in this part, although I don't think there is anything weird or specific about this particular script.

!INC Utils.Include
!INC Local Scripts.EAConstants-VBScript
' Author: Geert Bellekens
' Purpose: A wrapper class for a all EATaggedValues
' Date: 2023-05-09

'"static" property propertyNames
dim EATaggedValuePropertyNames
set EATaggedValuePropertyNames = nothing

'initializes the metadata for EA elements (containing all columnNames of t_object
function initializeEATaggedValuePropertyNames()
    dim result
    set result = getArrayListFromQueryWithHeaders("select top 1 * from t_attributetag")
    set EATaggedValuePropertyNames = result(0) 'get the headers
    dim i
    for i = 0 to EATaggedValuePropertyNames.Count -1
        EATaggedValuePropertyNames(i) = lcase(EATaggedValuePropertyNames(i))
    next
end function

Class EATaggedValue
    Private m_properties
    
    'constructor
    Private Sub Class_Initialize
        set m_properties = Nothing
        if EATaggedValuePropertyNames is nothing then
            initializeEATaggedValuePropertyNames
        end if
    end sub
    
    public default function Item (propertyName)
        Item = me.Properties.Item(lcase(propertyName))
    end function
    
    Public Property Get Properties
        set Properties = m_properties
    End Property
    
    Public Property Get ObjectType
        ObjectType = "EATaggedValue"
    End Property
    
    Public Property Get Name
        Name = me("Property")
    End Property
    
    Public Property Get Value
        Value = me("Value")
    End Property
    
    Public Property Get Notes
        Notes = me("Notes")
    End Property

    Public function initializeProperties(propertyList)
        'initialize with new Dictionary
        set m_properties = CreateObject("Scripting.Dictionary") '<= once it failed here
        dim i
        i = 0
        dim propertyName
        for each propertyName in EATaggedValuePropertyNames
            'fill the dictionary
            m_properties.Add propertyName, propertyList(i)
            'add the counter
            i =  i + 1
        next
    end function
end class

function getEATaggedValuesForElementID(elementID, ownerType)
    dim attributesDictionary
    set attributesDictionary = CreateObject("Scripting.Dictionary") '<= the other time here
    dim sqlGetdata
    select case ownerType
        case otElement
            sqlGetdata = "select * from t_objectProperties tv where tv.Object_ID = " & elementID
        case otAttribute
            sqlGetdata = "select * from t_attributeTag tv where tv.ElementID = " & elementID
        case otConnector
            sqlGetdata = "select * from t_connectorTag tv where tv.ElementID = " & elementID
        case otMethod
            sqlGetdata = "select * from t_operationTag tv where tv.ElementID = " & elementID
    end select
    dim queryResults
    set queryResults = getArrayListFromQuery(sqlGetdata)
    dim row
    for each row in queryResults
        dim newTaggedValue
        set newTaggedValue = New EATaggedValue
        newTaggedValue.initializeProperties row
        'add to dictionary based on ID
        attributesDictionary.Add newTaggedValue("ea_guid"), newTaggedValue
    next
    'return
    set getEATaggedValuesForElementID = attributesDictionary
end function

Solution

  • That particular error is quite misleading.

    The likely cause is a memory leak that is affecting COMs ability to instantiate a new instance of the Scripting.Dictionary object.

    Apparently, COM does report this error for memory leaks, which in itself is quite confusing (cannot confirm this as there is no official source for this claim).

    Sometimes, instead of out-of-memory errors, COM raises automation errors or interface errors.

    As for what to do to fix this, unfortunately, if it is a memory leak the only solution is to chuck more resources at it (RAM etc).