使用类的文本名称创建一个新对象

Question

是否可以通过使用类的文本名称将对象设置为类的新实例？

我将拥有一个类库，根据其他变量，我想在运行时获取这些类之一。

例如，我有“ CTest1”，“ CTest2”，“ CTest3”

我将具有类似于下面的功能

Function GetTestClass(lngClassNo as long) as Object
  Dim strClassName as String    
  strClassName = "CTest" & CStr(lngClassNo)
  Set GetTestClass = New instance of class(strClassName)
End Function

Answer 1

您可以使用元编程来做到这一点，尽管它看起来确实很麻烦。下面是一个使用几个辅助函数的示例（为了简洁而省略）：

Public Function CreateInstance(typeName As String) As Object
    Dim module As VBComponent
    Set module = LazilyCreateMPCache()

    If Not FunctionExists(typeName, module) Then
        Call AddInstanceCreationHelper(typeName, module)
    End If

    Dim instanceCreationHelperName As String
    instanceCreationHelperName = module.name & ".GetInstanceOf" & typeName
    Set CreateInstance = Application.Run(instanceCreationHelperName)
End Function

Sub AddInstanceCreationHelper(typeName As String, module As VBComponent)
   Dim strCode As String
   strCode = _
   "Public Function GetInstanceOf" & typeName & "() As " & typeName & vbCrLf & _
       "Set GetInstanceOf" & typeName & " = New " & typeName & vbCrLf & _
   "End Function"
   Call AddFunction(strCode, module)
End Sub

Answer 2

CallByName功能可以帮助您。假设您的项目中有一些类模块：clsSample0,clsSample1和clsSample2. 添加一个名为 的新类模块clsSpawner，它将所有目标类列为具有相同名称的公共变量，并用New关键字声明：

Public clsSample0 As New clsSample0
Public clsSample1 As New clsSample1
Public clsSample2 As New clsSample2

在标准模块中添加Function Spawn()代码：

Function Spawn(sClassName) As Object

    Set Spawn = CallByName(New clsSpawner, sClassName, VbGet)

End Function

用一些这样的代码测试它：

Sub TestSpawn()

    Dim objSample0a As Object
    Dim objSample0b As Object
    Dim objSample1 As Object
    Dim objSample2 As Object

    Set objSample0a = Spawn("clsSample0")
    Set objSample0b = Spawn("clsSample0")
    Set objSample1 = Spawn("clsSample1")
    Set objSample2 = Spawn("clsSample2")

    Debug.Print TypeName(objSample0a)            ' clsSample0
    Debug.Print TypeName(objSample0b)            ' clsSample0
    Debug.Print objSample0a Is objSample0b       ' False
    Debug.Print TypeName(objSample1)             ' clsSample1
    Debug.Print TypeName(objSample2)             ' clsSample2

End Sub

它是如何工作的？Spawn函数实例化clsSpawner并调用clsSpawner实例以返回请求的属性，实际上clsSpawner实例因New关键字声明而创建目标类的新实例并返回引用。

Answer 3

VBA中没有反射，所以我认为这是不可能的。恐怕你必须做类似以下的事情：

Function GetTestClass(lngClassNo as long) as Object

    Select Case lngClassNo
    Case 1
        Set GetTestClass = New CTest1
    Case 2
        Set GetTestClass = New CTest2
    ...

    End Select

End Function

除非您的 CTest 类是在 COM DLL 中定义的，在这种情况下您可以使用 CreateObject 语句。您需要使用 VB6 创建这样的 DLL，但不能在 Excel、Access 等中创建 DLL。

Function GetTestClass(lngClassNo as long) as Object

    Set GetTestClass = CreateObject("MyDll.CTest" & lngClassNo)

End Function