开发者

VBA Arrays - test for empty, create new, return element

开发者 https://www.devze.com 2023-03-11 01:56 出处:网络
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 ca

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.

0

精彩评论

暂无评论...
验证码 换一张
取 消