If arrays are returned by reference, why doesn't the following work:
'Class1 class module
Private v() As Double
Public Property Get Vec() As Double()
Vec = v()
End Property
Private Sub Class_Initialize()
ReDim v(0 To 3)
End Sub
' end class module
Sub Test1()
Dim c As Class1
Set c = New Class1
Debug.Print c.Vec()(1) ' prints 0 as expected
c.Vec()(1) = 5.6
Debug.Print c.Vec()(1) ' still prints 0
End Sub
You don't have a let property. Also, the get property is returning the entire array, rather than just the element in question. Change the return type of Property Get from Double() to just plain Double. Add Property Let. Note that it takes two inputs, but only one is passed to it. The last variable (MyValue, in this case) is assumed to get it's value from whatever is after the = sign. Put a break point somewhere early in Test1() and see how the values are affected in the Locals window. Compare the variables created by the original code versus my code:
'Class1 class module
Private v() As Double
Public Property Get Vec(index As Long) As Double
Vec = v(index)
End Property
Public Property Let Vec(index As Long, MyValue As Double)
v(index) = MyValue
End Property
Private Sub Class_Initialize()
ReDim v(0 To 3)
End Sub
' end class module
'Begin module
Sub Test1()
Dim c As Class1
Set c = New Class1
Debug.Print c.Vec(1) ' prints 0 as expected
c.Vec(1) = 5.6
Debug.Print c.Vec(1) ' prints 5.6
End Sub
'End module
In VBA, arrays are never returned by reference unless they are returned through a ByRef parameter. Furthermore, whenever you use = to assign an array to a variable, you've made a new copy of the array, even if you're assigning it to a ByRef argument inside of a procedure, so you're pretty much out of luck trying to make this work.
Some alternative are...
Use a VBA.Collection instead of an array.
Make your own class that encapsulates an array and exposes procedures for indirectly accessing and manipulating the internal array.
I want to suggest another nice way to do this using a Collection and a static Property without the need to use a class:
imagine you want to have the xlCVError enum as an array (or collection), e.g. to loop through it on errors and handle it based on the actual error.
The following is initialized once on access:
'from https://stackoverflow.com/a/56646199/1915920
Static Property Get XlCVErrorColl() As Collection
Dim c As Collection 'will be already initalized after 1st access
'because of "Static Property" above!
Set XlCVErrorColl = c
If Not c Is Nothing Then Exit Property
'initialize once:
Set c = New Collection
c.Add XlCVError.xlErrDiv0
c.Add XlCVError.xlErrNA
c.Add XlCVError.xlErrName
c.Add XlCVError.xlErrNull
c.Add XlCVError.xlErrNum
c.Add XlCVError.xlErrRef
c.Add XlCVError.xlErrValue
Set XlCVErrorColl = c
End Property
Turning this into an array or implementing it as an array is straight forward, but collections seem to be more useful to me, with the disadvantage that their elements are not implicitely typed/(compile-time-)type checked.
So this would e.g. turn it into an (read-only) array (with the in-mem-copy-disadvantage mentioned in other answers/comments):
'from https://stackoverflow.com/a/56646199/1915920
Static Property Get XlCVErrorArr() As XlCVError()
Dim a() As XlCVError
XlCVErrorArr = a
If UBound( a ) > 0 Then Exit Property
'initialize once:
Dim c As Collection: Set c = XlCVErrorColl
ReDim a(c.Count)
Dim i As Integer: For i = 1 To c.Count
a(i) = c(i)
Next i
XlCVErrorArr = a
End Function
So transforming the example from Clayton Ss answer into a static, modifiable module property using some array it would be:
'module (no class required)
'from https://stackoverflow.com/a/56646199/1915920
Private v() As Double
Static Property Get Vec(index As Long) As Double
If UBound(v) < 3 Then 'initialize once:
ReDim v(0 To 3) 'one could initialize it with anyting after here too
end if
Vec = v(index)
End Property
Public Property Let Vec(index As Long, MyValue As Double)
v(index) = MyValue
End Property
Related
I just recently moved from VB6 to VB.NET and I'm recoding an old app. So I'm pretty unexperienced with .NET so far.
I have multiple (lets say 4 in this code example) twodimensional string arrays (or actually an array of arrays) which I want to store as a ComboBox items ie. one twodimensional array is one item.
Public Class MyItem
Private sName As String
Private sArr As Array()
Public Sub New(ByVal Name As String, ParamArray Arr As Array())
sName = Name
sArr = Arr
End Sub
Public Property Arr() As Array()
Get
Return sArr
End Get
Set(ByVal sValue As Array())
sArr = sValue
End Set
End Property
Public Overrides Function ToString() As String
Return sName
End Function
End Class
---
Dim sMyArray as Array()
For i As Integer = 0 to 3
sMyArray = Nothing ' resetting the array before refilling it
'
' No code here but filling sMyArray by reading a text file, each line
' number as dim 1 and splitted each line into dim 2 with ";" using Split(sRead, ";")
' so Debub.Print(sMyArray(0)(0)) prints the beginning of the first line until first ";" <- this works fine
'
' Then passing sMyArray to a ComboBox item
'
ComboBox.Items.Add(New MyItem("item" & i, sMyArray))
Next i
The problem is that when recovering the arrays from ComboCox items only the last ComboBox item has array data. So for example
Dim sMyNewArray As Array() = ComboBox.Items.Item(0).Arr
Debug.Print(sMyNewArray(0)(0))
throws an error while
Dim sMyNewArray As Array() = ComboBox.Items.Item(3).Arr
Debug.Print(UBound(sMyNewArray(UBound(sMyNewArray))))
does not and prints the last item's last row's ubound
Can anyone figure out what is it I'm missing or tell me a better way to do this? I'm pretty sure there is one..
I'm not 100% sure, but I think the problem is in this section:
Dim sMyArray as Array()
For i As Integer = 0 to 3
sMyArray = Nothing ' resetting the array before refilling it
Arrays are technically reference types, but like strings, there's some extra compiler magic to make them feel at times more like value types, and I have a sense in this case the actual sMyArray reference was used (perhaps because of a ParamArrays optimzation), such that setting it to Nothing broke things. The more idiomatic way to write this code for .Net it like this:
For i As Integer = 0 to 3
Dim sMyArray as Array()
.Net has a much more sophisticated garbage collector than was available for VB6. We don't often set variables to Nothing any more, but instead just re-assign them or let them fall out of scope. In fact, setting a variable to Nothing can in rare cases be actively harmful. Moreover, we want to see the Dim keyword inside the loop, so you're working with a different variable on each iteration, with the smallest possible scope.
While I'm here, in .Net we pretty much never use the base Array type. Instead of this:
Private sArr As Array()
You pretty much always do this:
Private arr As String()()
or this, for true two-dimensional (non-jagged) arrays:
Private arr As String(,)
or, best of all, this:
Private arr As New List(Of String())
Since VB.Net has more collection types than just array.
Also, I don't have the link handy, but Microsoft's coding guidelines now explicitly ask you not to use hungarian warts for variable and class names (so sArr can just be arr). This is a change from the VB6 era because of changes to the language where the type is more likely to be implicit with the variable and improvements to the tooling, where the prefixes usually no longer add much utility and have been shown to hurt readability.
Not really sure why you have a 2 dimensional array, but here is a small sample NOT using the Array type. It uses just plain strings and string arrays. Let me know if this helps. This splits a few strings, then reads out the results after populating.
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim sMyArray()() As String
Dim line1 As String = "a;b;c;d 1;2;3;4;5"
Dim line2 As String = "z;x;y;w 99;65;32;21;18"
sMyArray = ParseString(line1)
cboBox1.Items.Add(New MyItem("System0", sMyArray))
sMyArray = ParseString(line2)
cboBox1.Items.Add(New MyItem("System1", sMyArray))
For i As Integer = 0 To cboBox1.Items.Count - 1
For j As Integer = 0 To UBound(cboBox1.Items(i).arr)
For k As Integer = 0 To UBound(cboBox1.Items(i).arr(j))
Debug.Write(cboBox1.Items(i).arr(j)(k) & " ")
Next
Next
Debug.WriteLine("")
Next
End Sub
Private Function ParseString(s As String) As String()()
Dim rows As String() = s.Split(" ")
Dim matrix As String()() = New String(rows.Length - 1)() {}
For i As Integer = 0 To rows.Length - 1
matrix(i) = rows(i).Split(";")
Next
Return matrix
End Function
End Class
Public Class MyItem
Private sName As String
Private sArr As String()()
Public Sub New(ByVal Name As String, ByVal ParamArray Arr As String()())
sName = Name
sArr = Arr
End Sub
Public Property Arr() As String()()
Get
Return sArr
End Get
Set(ByVal sValue As String()())
sArr = sValue
End Set
End Property
Public Overrides Function ToString() As String
Return sName
End Function
End Class
I'm trying to create a class with arrays in it, and I'm having issues creating the class for it...
CLASS:
Private pST(0 To 2) As String
Public Property Get ST() As String
ST() = pST()
End Property
Public Property Let ST(value() As String) '<---- ERROR HERE
pST() = value()
End Property
CODE RUN:
Sub test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
foo.ST(0) = "test"
Debug.Print foo.ST(0)
End Sub
THE ERROR:
Compile error:
Definitions of property procedures for the same property are inconsistent, or property procedure has an optional parameter, a ParamArray, or an invalid Set final parameter.
THE QUESTION:
How can I properly initialize a class with arrays as variables?
EDIT: in relation to Mat's Mug response
CLASS CHANGED:
Private pST As Variant
Public Property Get STContent(ByVal index As Long) As String
STContent = pST(index)
End Property
Public Property Let STContent(ByVal index As Long, ByVal value As String)
pST(index) = value
End Property
Private Sub Class_Initialize()
ReDim pST(0 To 2)
End Sub
CODE RUN TO TEST:
Sub test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
foo.STContent(0) = "test" '<--- Type mismatch here
Debug.Print foo.STContent(0)
End Sub
Your getter would need to return a String() array for the types to be consistent:
Public Property Get ST() As String()
However I wouldn't recommend exposing an array like this. First because assigning typed arrays is rather painful, second because the setter (Property Let) is actually cheating here:
Public Property Let ST([ByRef] value() As String)
Unless you specify ByVal explicitly, a parameter is always passed ByRef in VBA... except there's this quirk about Property Let - the RHS/value parameter is always passed ByVal at run-time.
And arrays can only ever be passed ByRef.
Therefore, a property that gets (or assigns, actually) a whole array doesn't make much sense.
A better way would be to encapsulate the array (I'd make it a Variant though), and expose its contents (not the array itself) through an indexed property:
Private internal As Variant 'String array
'...
Public Property Get Content(ByVal index As Long) As String
Content = internal(index)
End Property
Public Property Let Content(ByVal index As Long, ByVal value As String)
internal(index) = value
End Property
You have a lot of issues there.
First, your Property Get needs to return a String array. Second, your array needs to be dynamic, or you need to rewrite the whole thing so that you pass an index value to it, otherwise there is no way to indicate which value you are passing to the array. So, for example, using a dynamic array:
Private pST() As String
Public Property Get ST() As String()
ST = pST
End Property
Public Property Let ST(value() As String)
pST() = value()
End Property
and the calling code:
Sub test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
Dim asData() As String
ReDim asData(0)
asData(0) = "test"
foo.ST = asData
Debug.Print foo.ST()(0)
End Sub
Unfortunately, I couldn't be sure form the original what the intent was.
It is getting late here but give it a try. In the module:
Option Explicit
Sub Test()
Dim foo As cPurchaseOrder
Set foo = New cPurchaseOrder
foo.AddValueToSt "test", 1
Debug.Print foo.ST(1)
End Sub
In the Class:
Option Explicit
Private pST
Public Property Get ST() As Variant
ST = pST
End Property
Public Property Let ST(value As Variant)
pST = value
End Property
Public Function AddValueToSt(value As Variant, position As Long)
pST(position) = value
End Function
Private Sub Class_Initialize()
ReDim pST(2)
End Sub
This is my way to use the Factory Method Pattern. When I say "my way", for me this pattern is translated to "Whenever some OOP requires more than 5 minutes of thinking simply add a function."
I am trying to create a VBA function which writes an array to a .NET System.Collections.ArrayList and returns it.
So far I have:
Function arrayToArrayList(inArray As Variant) As ArrayList
'function to take input array and output as arraylist
If IsArray(inArray) Then
Dim result As New ArrayList
Dim i As Long
For i = LBound(inArray) To UBound(inArray)
result.Add inArray(i) 'throws the error
Next i
Else
Err.Raise 5
End If
Set arrayToArrayList = result
End Function
Called with (for example)
Sub testArrayListWriter()
'tests with variant/string array
'intend to pass array of custom class objects
Dim result As ArrayList
Dim myArray As Variant
myArray = Split("this,will,be,an,array",",")
Set result = arrayToArrayList(myArray)
End Sub
But I get the error
Variable uses an Automation type not supported in Visual Basic
Presumably because my array is not the correct type (maybe Variant). However
Dim v As Variant, o As Variant
v = "test_string"
set o = New testClass
result.Add v 'add a string in variant form
result.Add o 'add an object in variant form
raises no errors, so the problem isn't directly to do with the Variant type
What's going on here, and is there any way of writing an array of unspecified type to the ArrayList, or will I have to define the type of inArray?
Change
result.Add inArray(i)
to
result.Add CVar(inArray(i))
Two ways to do this. First is late binding if you don't have a reference to mscorlib.dll. You'll see that I've changed your ArrayList to Object for declaring the function and the return value (retVal). The test sub also declares result as Object. The retVal and result are both late bound to System.Collections.ArrayList. You also need to declare inArray and myArray as dynamic arrays of string. In your example, Split expects returns an array of strings, so you need provide a declared dynamic array of strings. If you wanted to other object types, then you'd pass those declared object types to your function.
Private Function arrayToArrayList(inArray() As String) As Object
'function to take input array and output as arraylist
Dim retVal As Object
Set retVal = CreateObject("System.Collections.ArrayList")
If IsArray(inArray) Then
Dim i As Long
For i = LBound(inArray) To UBound(inArray)
retVal.Add inArray(i)
Next i
Else
Err.Raise 5
End If
Set arrayToArrayList = retVal
End Function
Public Sub testArrayListWriter()
'tests with variant/string array
'intend to pass array of custom class objects
Dim result As Object
Dim myArray() As String
Set result = CreateObject("System.Collections.ArrayList")
myArray = Split("this,will,be,an,array", ",")
Set result = arrayToArrayList(myArray)
End Sub
The second way is to add a reference to mscorlib.dll through the Tools->Reference menu item. When the dialog box appears you'll have to click browse. You'll need to browse to C:\Windows\Microsoft.NET\Framework and then select the folder with the current version of .NET on your machine. In that folder you'll find mscorlib.dll and mscorelib.tlb. Highlight the file ending in .TLB file, click the Open button, on the Tools Reference dialog, click OK.
Now you can use any of the classes in Systems.Collections directly in your code. This is called early binding and looks like this
Private Function arrayToArrayList(inArray() As String) As ArrayList
'function to take input array and output as arraylist
Dim retVal As ArrayList
If IsArray(inArray) Then
Dim i As Long
For i = LBound(inArray) To UBound(inArray)
retVal.Add inArray(i)
Next i
Else
Err.Raise 5
End If
Set arrayToArrayList = retVal
End Function
Public Sub testArrayListWriter()
'tests with variant/string array
'intend to pass array of custom class objects
Dim result As ArrayList
Dim myArray() As String
myArray = Split("this,will,be,an,array", ",")
Set result = arrayToArrayList(myArray)
End Sub
I think the problem is with the assignment of the return value from the Split function to a variable that has not been decalred anywhere.
Try adding:
Dim myArray() as string
inside the testArrayListWriter() procedure.
Problem
When you want to look directly at the arguments of your UDF (not their values, which can be passed directly, but the formula that gave these values), you can use Application.Caller.Formula and parse out the arguments to find out.
Is there any way to see the line of VBA code which called a Function, so that you can parse out its arguments in a similar way?
Background
A while ago I created a UDF which was essentially another approach to array functions*. What I wanted to do was take some statement which evaluates to True/False
LEN(A1)>LEN(B1)
And evaluate it over an array. So say the above function was placed in cell A1, then to evaluate over the array A1:A100 would be the same as creating the array
{LEN(A1)>LEN(B1),LEN(A2)>LEN(B2),[...]} 'you may recognise this as an array formula ={LEN(A1:A100)>LEN(B1:B100)}
*For context, this was before I knew about array formulae
I was frustrated with the syntax of certain array-handling Excel functions, like COUNTIF, which takes the arguments in the following form
COUNTIF(range_To_Evalueate_Over, "string_Representing_Boolean_Test")
The string argument presents the following limitations
Not any boolean returning statement can be used as a test; there is no way of looking at properties of the range which you evaluate over other than their values
So you can't use functions like LEN() to get more data about the range
You can not reference other cells relative to the range (Like B1 relative to A1)
The string is static at runtime, you cannot step-into the function to see what the string will evaluate to for a given cell from the range you are evaluating
I much prefer the versatility of the conditional formatting formulae. They take the form of array formulae, where any offsets (B1 relative to A1) are calculated relative to the TL cell of the range that the conditional formatting is applied to.
That prompted me to create a UDF which has a structure like this
evaluateOverRange(range_to_evalute_over As Range, boolean_test_on_TL_Cell As Boolean) As Boolean() 'returns an array equal in size to the evaluate range
Used like
evaluateOverRange(A1:A100,LEN(A1)<LEN(B1))
Note
Boolean test is not a string, so can be evaluated step by step in Excel
Boolean test is guaranteed to be Boolean thanks to type declaration
Boolean test is relative to the first cell (A1) in the evaluate range (A1:A100)
I.e. B1 is replaced with A1.Offset(0,1)
Since boolean_test_on_TL_Cell is not a string, it tells us nothing about the actual test, it just passes the result of the test on the A1, it is actually useless within the UDF so is ignored
To obtain the test string "LEN(A1)<LEN(B1)", the Application.Caller.Formula is read, and the relevant argument of evaluateOverRange is parsed out
In order to evaluate some worksheet function over an array in VBA, you can use the Evaluate method
Dim colA As Range: Set colA = [A1:A100] 'range_to_evaluate_over in my udf
Dim cellA As Range
Dim cellB as Range
Dim outputArray(1 To 100) As Boolean
For i = 1 To 100
Set cellA = colA(i)
Set cellB = cellA.Offset(0,1) 'all cells that arent the TL cell in colA (i.e., not A1) are set relative to the top left cell
outputArray(i) = Evaluate("LEN(" & cellA.Value & ")>LEN(" & cellB.Value ")")
Next i
Right, so all that was for worksheet functions, and somewhat pointless given array functions do the same thing. But now I want to use the same approach within VBA.
Specifically, I want to filter an array of custom classes based on some function of their properties, using actual VBA Boolean returning code rather than a string.
Sub FilterMyClassArray() 'Prints how many items in arrayToFilter whose properties match certain conditions
Dim arrayToFilter(1 To 100) As New myClass
Dim filteredArray() As myClass
Dim tlClass As myClass 'pretend class used only for intellisense and to create
boolean test
Set filteredArray = filterClassArray(arrayToFilter, tlClass.PropertyA > 3 And
tlClass.PropertyB = "hat")
Debug.Print "Number left after filtering:" ; Ubound(filteredArray)
End Sub
Function filterClassArray(ByVal inutArray() As myClass, classTest As Boolean) As myClass 'returns an output array which is equal to the input array filtered by some test
'Somehow get what classTest actually was
'Evaluate classTest over each item in inputArray
'If boolean test evaluates to true, add to output array, otherwise skip
End Function
I imagine some manipulation of the code modules will be required (both to get the string of code which represents the test, and to actually evaluate it), but I want to check feasibility before I dig too deep.
I've been having a think about this and a solution might be possible if you'd be prepared to use something approximating a Linq syntax.
If I understand the requirements correctly, you need to:
obtain a string value for each property name,
record the evaluation and ultimately run it as a string,
have intellisense access to the properties, and
have the ability to debug the evaluation on each iteration.
Regarding #1 and #3, the only way of doing this in VBA would be to code the values manually. If you code them in your class then the class can become cumbersome and some might say it compromises the single responsibility principle (https://en.wikipedia.org/wiki/Single_responsibility_principle). If you code them in a separate 'container' (eg class, type, collection, etc.), then there's a risk of some being missed or of corruption if you change the property names. An Interface class might mitigate these issues.
For #2, I can't see any way around it: the evaluation must be entered as a string. An enum (and associated intellisense) might alleviate things a bit though.
Item #4 is purely a coding architecture issue.
First the syntax
I'm sure there are VBA solutions on the internet which implement a pretty decent mock-up of Linq, but further down is a skeleton version to give you the idea. The end result is that your query syntax could look like this:
Dim query As cLinq
Dim p As INameable
Dim arrayToFilter(1 To 100) As INameable
Dim filteredArray() As INameable
Set query = New cLinq
With query
.SELECT_USING_INTERFACE p
.FROM arrayToFilter
.WHERE p.PropertyA, EQUAL_TO, 3
.AND_WHERE p.PropertyB, EQUAL_TO, "hat"
filteredArray = .EXECUTE
End With
The interface
As far as VBA is concerned an interface is really just a class module with a list of properties and methods that you want a class to implement. In your case, I've created a class and called it INameable, with the following sample code to match your example:
Option Explicit
Public Property Get PropertyA() As Long
End Property
Public Property Let PropertyA(RHS As Long)
End Property
Public Property Get PropertyB() As String
End Property
Public Property Let PropertyB(RHS As String)
End Property
Your MyClass class then implements this interface. For the sake of consistency, I've called the class cMyClass:
Option Explicit
Implements INameable
Private mA As Long
Private mB As String
Private Property Let INameable_PropertyA(RHS As Long)
mA = RHS
End Property
Private Property Get INameable_PropertyA() As Long
INameable_PropertyA = mA
End Property
Private Property Let INameable_PropertyB(RHS As String)
mB = RHS
End Property
Private Property Get INameable_PropertyB() As String
INameable_PropertyB = mB
End Property
I've created a second class, called cNames, which also implements the interface, and this one produces the string names of the properties. As a quick and dirty method it just stores the name of the last property used:
Option Explicit
Implements INameable
Private mName As String
Private Property Let INameable_PropertyA(RHS As Long)
End Property
Private Property Get INameable_PropertyA() As Long
mName = "PropertyA"
End Property
Private Property Let INameable_PropertyB(RHS As String)
End Property
Private Property Get INameable_PropertyB() As String
mName = "PropertyB"
End Property
Public Property Get CurrentName() As String
CurrentName = mName
End Property
You wouldn't have to use an interface and some might argue it's not necessary or even correct to do so, but at least it gives you an idea of how it could be implemented if you went this route.
The Linq class
The final class is really just a helper class to create the intellisense syntax you need and to process the evaluation. It's by no means thorough, but might get you started if the idea appealed to you. I've called this class cLinq:
Option Explicit
'Enumerator to help with intellisense.
Public Enum Operator
EQUAL_TO
GREATER_THAN
LESS_THAN
GREATER_OR_EQUAL_TO
LESS_OR_EQUAL_TO
NOT_EQUAL_TO
End Enum
Private mP As cNames
Private mQueries As Collection
Private mByAnd As Boolean
Private mFromArray As Variant
Public Sub SELECT_USING_INTERFACE(p As INameable)
'Insantiate the name of properties class.
Set mP = New cNames
Set p = mP
End Sub
Public Sub FROM(val As Variant)
'Array containing objects to be interrogated.
mFromArray = val
End Sub
Public Sub WHERE(p As Variant, opr As Operator, val As Variant)
'First query.
Set mQueries = New Collection
AddQuery opr, val
End Sub
Public Sub AND_WHERE(p As Variant, opr As Operator, val As Variant)
'Subsequent query using AND.
mByAnd = True
AddQuery opr, val
End Sub
Public Sub OR_WHERE(p As Variant, opr As Operator, val As Variant)
'Subsequent query using OR.
mByAnd = False
AddQuery opr, val
End Sub
Public Function EXECUTE() As Variant
Dim o As Object
Dim i As Long
Dim result As Boolean
Dim matches As Collection
Dim output() As Object
'Iterate the array of objects to be checked.
Set matches = New Collection
For i = LBound(mFromArray) To UBound(mFromArray)
Set o = mFromArray(i)
result = EvaluatedQueries(o)
If result Then matches.Add o
Next
'Transfer matched objects to an array.
ReDim output(0 To matches.Count - 1)
i = LBound(output)
For Each o In matches
Set output(i) = o
i = i + 1
Next
EXECUTE = output
End Function
Private Function EvaluatedQueries(o As Object) As Boolean
Dim pep As Variant, val As Variant
Dim evalString As String
Dim result As Boolean
For Each pep In mQueries
'Obtain the property value by its string name
val = CallByName(o, pep(0), VbGet)
'Build the evaluation string.
evalString = ValToString(val) & pep(1)
'Run the evaluation
result = Evaluate(evalString)
'Exit the loop if AND or OR conditions are met.
If mQueries.Count > 1 Then
If (mByAnd And Not result) Or (Not mByAnd And result) Then Exit For
End If
Next
EvaluatedQueries = result
End Function
Private Sub AddQuery(opr As Operator, val As Variant)
Dim pep(1) As Variant
'Create a property/evaluation pair and add to collection,
'eg pep(0): "PropertyA", pep(1): " = 3"
pep(0) = mP.CurrentName
pep(1) = OprToString(opr) & ValToString(val)
mQueries.Add pep
End Sub
Private Function OprToString(opr As Operator) As String
'Convert enum values to string operators
Select Case opr
Case EQUAL_TO
OprToString = " = "
Case GREATER_THAN
OprToString = " > "
Case LESS_THAN
OprToString = " < "
Case GREATER_OR_EQUAL_TO
OprToString = " >= "
Case LESS_OR_EQUAL_TO
OprToString = " <= "
Case NOT_EQUAL_TO
OprToString = " <> "
End Select
End Function
Private Function ValToString(val As Variant) As String
Dim result As String
'Add inverted commas if it's a string.
If VarType(val) = vbString Then
result = """" & val & """"
Else
result = CStr(val)
End If
ValToString = result
End Function
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 variable 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.