Reputation: 2125
How to write a function that will return the number of elements in any 1D array regardless of its data type ?
So far I have devised the following function:
Function ArrLen(ByRef arr As Variant) As Long
If IsEmpty(arr) Then GoTo EmptyArr
On Error GoTo EmptyArr
ArrLen = UBound(arr) - LBound(arr) + 1
Exit Function
EmptyArr:
ArrLen = 0
End Function
I works with arrays of all built-in types, but it does not work with arrays of User-Defined Types.
Below are the contents of the entire VBA Module of a M.C.R. Example:
Option Explicit
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Dim ArrOfIntegersN(1 To 6) As Integer
Dim ArrOfStringsN(0 To 4) As String
Dim ArrOfShapesN(1 To 4) As Shape
Dim ArrOfVariantsN(0 To 2) As Variant
Dim ArrOfRectsN(1 To 2) As RECT
Dim ArrOfIntegers() As Integer
Dim ArrOfStrings() As String
Dim ArrOfShapes() As Shape
Dim ArrOfVariants() As Variant
Dim ArrOfRects() As RECT
Sub main()
Debug.Print ArrLen(ArrOfIntegersN) & " Integers"
Debug.Print ArrLen(ArrOfStringsN) & " Strings"
Debug.Print ArrLen(ArrOfShapesN) & " Shapes"
Debug.Print ArrLen(ArrOfVariantsN) & " Variants"
Debug.Print ArrLen(ArrOfRectsN) & " Rectangles" 'Error
Debug.Print ArrLen(ArrOfIntegers) & " Integers"
Debug.Print ArrLen(ArrOfStrings) & " Strings"
Debug.Print ArrLen(ArrOfShapes) & " Shapes"
Debug.Print ArrLen(ArrOfVariants) & " Variants"
Debug.Print ArrLen(ArrOfRects) & " Rectangles" 'Error
ReDim ArrOfIntegers(1 To 6)
ReDim ArrOfStrings(0 To 4)
ReDim ArrOfShapes(1 To 4)
ReDim ArrOfVariants(0 To 2)
ReDim ArrOfRects(1 To 2)
Debug.Print ArrLen(ArrOfIntegers) & " Integers"
Debug.Print ArrLen(ArrOfStrings) & " Strings"
Debug.Print ArrLen(ArrOfShapes) & " Shapes"
Debug.Print ArrLen(ArrOfVariants) & " Variants"
Debug.Print ArrLen(ArrOfRects) & " Rectangles" 'Error
End Sub
Function ArrLen(ByRef arr As Variant) As Long
If IsEmpty(arr) Then GoTo EmptyArr
On Error GoTo EmptyArr
ArrLen = UBound(arr) - LBound(arr) + 1
Exit Function
EmptyArr:
ArrLen = 0
End Function
The three errors that I am getting are occurring at the compilation time. The error messages are:
"Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late-bound functions"
So, I am thinking: grrrrrr, it is some kind of silly VBA limitation, but then I analyze this error message in detail ...and notice that:
Rect
IS defined in a Public module !!!.Rect
is also declared as a Public global variableQ1: Am I misunderstanding this error message somehow? How?
Q2: How to make the ArrLen() function universal so it can also accept arrays of User Defined Types (UDT) ?
Note: I am NOT interested in solutions that propose to use Classes in place of the User Defined Types, because I have no control of what Types are passed to my functions from a 3rd party code, which I cannot alter.
EDIT: This answer to another question indirectly answers Q1 by pointing out that Object Modules
actually are Class Modules
, however Q2 has been answered only by the member "Ambie" below.
Upvotes: 0
Views: 116
Reputation: 4977
As noted in the comments, user-defined types must be defined in an Object Module to be passed as a variant to a function. It's a misleading phrase because an Object Module is actually a Class Module.
However, it is possible to read the element count of an array of UDTs defined in a Module (or any array for that matter). You would achieve this by reading the SAFEARRAY structure (https://learn.microsoft.com/en-us/windows/win32/api/oaidl/ns-oaidl-safearray) which you access from the array pointer rather than the array itself.
So you could pass the array pointer into your function and thereby avoid the problem of trying to coerce the array to a variant. If, as you say in your question, you are certain the array is only 1 dimension, then coding is relatively straightforward. Arrays of more than one dimension could be used but you'd need a little bit of pointer arithmetic (still pretty trivial, though) to get to the dimension you're after. Note that the code below assumes 64-bit:
Option Explicit
Private Declare PtrSafe Function GetPtrToArray Lib "VBE7" _
Alias "VarPtr" (ByRef Var() As Any) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" ( _
ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long)
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type SAFEARRAY_1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As LongPtr
rgsabound(0) As SAFEARRAYBOUND
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Sub RunMe()
Dim arrOfRects(0 To 5) As RECT
Dim ptr As LongPtr
Dim n As Long
ptr = GetPtrToArray(arrOfRects)
n = GetElementCount(ptr)
Debug.Print n
End Sub
Private Function GetElementCount(arrPtr As LongPtr) As Long
Dim saPtr As LongPtr
Dim sa As SAFEARRAY_1D
CopyMemory saPtr, ByVal arrPtr, 8
CopyMemory sa, ByVal saPtr, LenB(sa)
GetElementCount = sa.rgsabound(0).cElements
End Function
Upvotes: 3