Please would someone who understands VBA Arrays (Access 2003) help me with the following code.
The idea is that ClassA holds a dynamic array of ClassB instances. The dynamic array starts empty. As callers call ClassA.NewB() then a new instance of ClassB is created, added to the array, and returned to the caller. The problem is that I can't return the new instance of ClassB to the caller, but get "Runtime error 91: Object variable or With block var开发者_开发百科iable not set"
Also, a little WTF occurs where UBound() fails but wrapping the exact same call in another function works!?!? (Hence MyUbound() )
I'm from a C++ background and this VBA stuff is all a bit strange to me!
Thanks for any help!
Main code:
Dim a As clsClassA
Dim b As clsClassB
Set a = New clsClassA
a.Init
Set b = a.NewB(0)
clsClassA:
Option Compare Database
Private a() As clsClassB
Public Sub Init()
Erase a
End Sub
Public Function NewB(i As Integer) As Variant
'If (UBound(a, 1) < i) Then ' FAILS: Runtime error 9: Subscript out of range
If (MyUBound(a) < i) Then ' WORKS: Returns -1
ReDim Preserve a(0 To i)
End If
NewB = a(i) ' FAILS: Runtime error 91: Object variable or With block variable not set
End Function
Private Function MyUBound(a As Variant) As Long
MyUBound = UBound(a, 1)
End Function
clsClassB:
Option Compare Database
' This is just a stub class for demonstration purposes
Public data As Integer
Your approach stores a collection of ClassB instances in an array. For each instance you add, you must first ReDim the array. ReDim is an expensive operation, and will become even more expensive as the number of array members grows. That wouldn't be much of an issue if the array only ever held a single ClassB instance. OTOH, if you don't intend more than one ClassB instance, what is the point of storing it in an array?
It makes more sense to me to store the collection of instances in a VBA Collection. Collections are fast for this, and aren't subject to the dramatic slow downs you will encounter with an array as the number of items grows.
Here is a Collection approach for clsClassA.
Option Compare Database
Option Explicit
Private mcolA As Collection
Private Sub Class_Initialize()
Set mcolA = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolA = Nothing
End Sub
Public Function NewB(ByVal i As Integer) As Object
Dim objB As clsClassB
If i > mcolA.Count Then
Set objB = New clsClassB
mcolA.Add objB
Else
Set objB = Nothing
End If
Set NewB = objB
Set objB = Nothing
End Function
The only change I made to clsClassB was to add Option Explicit.
This procedure uses the class.
Public Sub test_ClassA_NewB()
Dim a As clsClassA
Dim b As clsClassB
Set a = New clsClassA
Set b = a.NewB(1) '' Collections are one-based instead of zero-based
Debug.Print TypeName(b) ' prints clsClassB
Debug.Print b.data '' prints 0
b.data = 27
Debug.Print b.data '' prints 27
Set b = Nothing
Set a = Nothing
End Sub
Try this:
Public Function NewB(i As Integer) As Variant
'If (UBound(a, 1) < i) Then ' FAILS: Runtime error 9: Subscript out of range
If (MyUBound(a) < i) Then ' WORKS: Returns -1
ReDim Preserve a(0 To i)
End If
Set a(i) = New clsClassB
Set NewB = a(i)
End Function
You need to set a(i) to a new instance of the class (or it will simply be null), you also need to use Set
as you're working with an object...
I'd perhaps also suggest changing the return type of NewB to clsClassB
rather than Variant
.
You could also do
Public Sub Init()
ReDim a(0 To 0)
Set a(0) = New Class2
End Sub
to remove the need for the special UBound function.
The UBound
function throws this error when you try to use it on an array with no dimension (which is your case since you did an Erase
on the array). You should have an error handler in your function to treat this case.
I use a special function to check if the array is empty, but you can just use parts of it for error handling.
Public Function IsArrayEmpty(ByRef vArray As Variant) As Boolean
Dim i As Long
On Error Resume Next
IsArrayEmpty = False
i = UBound(vArray) > 0
If Err.Number > 0 Then IsArrayEmpty = True
On Error GoTo 0
End Function
Also, if you still want to do an array then you could
redim preserve MyArray(lbound(MyArray) to ubound(MyArray)*2)
which will lesson the amount of times it redimensions, you would need a counter to redimension it at the very end.
Also, Dictionaries are supposed to be really fast (and more versatile than collections), they're like collections and you need to add a reference to Microsoft Scripting Runtime if you want to do dictionaries.
精彩评论