How to get Array Dimension(array parameter pass error)?

Question

I'm trying to get the dimension of an array via PeekArray and SafeArrayGetDim API, But the "Type mismatch" when compiling. And if Debug.Print SafeArrayGetDim(PeekArray(TestArray).Ptr) will work fine.

Please find below the VB code. Any help will be greatful.

Option Explicit

Private Type PeekArrayType
    Ptr As Long
    Reserved As Currency
End Type

Private Declare Function PeekArray Lib "kernel32" Alias "RtlMoveMemory" ( _
    Arr() As Any, Optional ByVal Length As Long = 4) As PeekArrayType

Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByVal Ptr As Long) As Long


Sub GetArrayDimension()
    Dim TestArray() As Long
    ReDim TestArray(3, 2)
    Debug.Print fnSafeArrayGetDim(TestArray)
End Sub


Function fnSafeArrayGetDim(varRunArray As Variant) As Long
    Dim varTmpArray() As Variant
    varTmpArray = varRunArray
    fnSafeArrayGetDim = SafeArrayGetDim(PeekArray(varTmpArray).Ptr)
End Function

Answer 1

Here is a working fnSafeArrayGetDim function

Option Explicit

#Const HasPtrSafe = (VBA7 <> 0) Or (TWINBASIC <> 0)

#If Win64 Then
    Private Const PTR_SIZE                  As Long = 8
#Else
    Private Const PTR_SIZE                  As Long = 4
#End If

#If HasPtrSafe Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#End If

Public Function fnSafeArrayGetDim(varRunArray As Variant) As Long
    Const VT_BYREF      As Long = &H4000
    Dim lVarType        As Long
    Dim lPtr            As LongPtr
    
    Call CopyMemory(lVarType, varRunArray, 2)
    If (lVarType And vbArray) <> 0 Then
        Call CopyMemory(lPtr, ByVal VarPtr(varRunArray) + 8, PTR_SIZE)
        If (lVarType And VT_BYREF) <> 0 Then
            Call CopyMemory(lPtr, ByVal lPtr, PTR_SIZE)
        End If
        If lPtr <> 0 Then
            Call CopyMemory(fnSafeArrayGetDim, ByVal lPtr, 2)
        End If
    End If
End Function

Private Sub Form_Load()
    Dim TestArray() As Long
    ReDim TestArray(3, 2)
    Debug.Print fnSafeArrayGetDim(TestArray)
End Sub

You don't need PeekArray as you are dealing with pure Variants not arrays like Variant() (array of Variants), Long() (array of Longs) or Byte() (array of Bytes) generally a type ending with () in VB6 is so called SAFEARRAY in COM parlance.

So your varRunArray is a pure Variant that points to a SAFEARRAY in its pparray member which is located at VarPtr(varRunArray) + 8. Once you get this pointer you must heed the VT_BYREF flag in Variant's vt which introduces a double indirection (you have to dereference lPtr = *lPtr once more). At this point if you get a non-NULL pointer to the SAFEARRAY structure then the cDim member is in the first 2 bytes.

Answer 2

Here 's my solution, the ArrayDims function, adapted from wqw's post, above. In addition to wqw's basic logic, this solution will compile under VBA7/64-bit Office environments; it includes improved self-documentation and explanatory commentary; it eliminates the embedded constants and, instead, uses standard VB/VBA Type structures and Enum values where useful, and provides all associated Type elements and Enum values for reference. You can, of course, pare this down to the minimum necessary declarations and Enum values.

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
    Private Declare Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If

Enum VariantTypes
    VTx_Empty = vbEmpty         '(0) Uninitialized
    VTx_Null = vbNull           '(1) No valid data
    VTx_Integer = vbInteger     '(2)
    VTx_Long = vbLong           '(3)
    VTx_FloatSingle = vbSingle  '(4) Single-precision floating-point
    VTx_FloatDouble = vbDouble  '(5) Double-precision floating-point
    VTx_Currency = vbCurrency   '(6)
    VTx_DATE = vbDate           '(7)
    VTx_String = vbString       '(8)
    VTx_Object = vbObject       '(9)
    VTx_Error = vbError         '(10) An Error condition code
    VTx_Boolean = vbBoolean     '(11)
    VTx_Variant = vbVariant     '(12) Used only for arrays of Variants
    VTx_Byte = vbByte           '(17)
    VTx_UDT = vbUserDefinedType '(36) User-defined data types
    VTx_Array = vbArray         '(8192)
    VTx_ByRef = &H4000          '(16384) Is an indirect pointer to the Variant's data
End Enum

Type VariantStruct  'NOTE - the added "X_..." prefixes force the VBE Locals window to display the elements in
                    'their correct adjacency order:
    A_VariantType      As Integer  '(2 bytes) See the VariantTypes Enum, above.
    B_Reserved(1 To 6) As Byte     '(6 bytes)
    C_Data             As LongLong '(8 bytes) NOTE: for an array-Variant, its Data is a pointer to the array.
End Type

Type ArrayStruct    'NOTE - the added "X_..." prefixes force the VBE Locals window to display the elements in
                    'their correct adjacency order:
                 
    A_DimCount      As Integer  '(aka cDim) 2 bytes: The number of dimensions in the array.
    B_FeatureFlags  As Integer  '(aka fFeature) 2 bytes: See the FeatureFlags Enum, below.
    C_ElementSize   As Long     '(aka cbElements) 4 bytes: The size of each element in the array.
    D_LockCount     As Long     '(aka cLocks) 4 bytes: The count of active locks on the array.
    E_DataPtr       As Long     '(aka pvData) 4 bytes: A pointer to the first data element in the array.
    F_BoundsInfoArr As LongLong '(aka rgsabound) 8 bytes, min.: An info-array of SA_BoundInfo elements (see below)
                                ' that contains bounds data for each dimension of the safe-array.  There is one
                                ' SA_BoundInfo element for each dimension in the array.  F_BoundsInfoArr(0) holds
                                ' the information for the right-most dimension and F_BoundsInfoArr[A_DimCount - 1]
                                ' holds the information for the left-most dimension.  Each SA_BoundInfo element is
                                ' 8 bytes, structured as follows:
End Type

Private Type SA_BoundInfo
    ElementCount As Long        '(aka cElements) 4 bytes: The number of elements in the dimension.
    LBoundVal As Long           '(aka lLbound) 4 bytes: The lower bound of the dimension.
End Type

Enum FeatureFlags
    FADF_AUTO = &H1         'Array is allocated on the stack.
    FADF_STATIC = &H2       'Array is statically allocated.
    FADF_EMBEDDED = &H4     'Array is embedded in a structure.
    FADF_FIXEDSIZE = &H10   'Array may not be resized or reallocated.
    FADF_BSTR = &H100       'An array of BSTRs.
    FADF_UNKNOWN = &H200    'An array of IUnknown pointers.
    FADF_DISPATCH = &H400   'An array of IDispatch pointers.
    FADF_VARIANT = &H800    'An array of VARIANT type elements.
    FADF_RESERVED = &HF0E8  'Bits reserved for future use.
End Enum

Function ArrayDims(SomeArray As Variant) As Long 'Cast the array argument to an array-Variant (if it isn't already)
                                                 'for a uniform reference-interface to it.
    '
    'Returns the number of dimensions of the specified array.
    '
    'AUTHOR: Peter Straton
    '
    'CREDIT: Adapted from wqw's post, above.
    '
    '*************************************************************************************************************
    
    Dim DataPtrOffset   As Integer
    Dim DimCount        As Integer  '= ArrayStruct.A_DimCount (2 bytes)
    Dim VariantType     As Integer  '= VariantStruct.A_VariantType (2 bytes)
    Dim VariantDataPtr  As LongLong '= VariantStruct.C_Data (8 bytes). See note about array-Variants' data, above.
    
    'Check the Variant's type
    
    Call CopyMemory(VariantType, SomeArray, LenB(VariantType))
    If (VariantType And VTx_Array) Then
        'It is an array-type Variant, so get its array data-pointer
        
        Dim VariantX As VariantStruct   'Unfortunately, in VB/VBA, you can't reference the size of a user-defined
                                        'data-Type element without instantiating one.
        DataPtrOffset = LenB(VariantX) - LenB(VariantX.C_Data) 'Takes advantage of C_Data being the last element
        Call CopyMemory(VariantDataPtr, ByVal VarPtr(SomeArray) + DataPtrOffset, LenB(VariantDataPtr))
        
        If VariantDataPtr <> 0 Then
            If (VariantType And VTx_ByRef) Then
                'The passed array argument was not an array-Variant, so this function-call's cast to Variant type
                'creates an indirect reference to the original array, via the Variant parameter.  So de-reference
                'that pointer.
                
                Call CopyMemory(VariantDataPtr, ByVal VariantDataPtr, LenB(VariantDataPtr))
            End If
            
            If VariantDataPtr <> 0 Then
                'Now have a legit Array reference, so get and return its dimension-count value
                
                Call CopyMemory(DimCount, ByVal VariantDataPtr, LenB(DimCount))
            End If
        End If
    End If
    
    ArrayDims = DimCount
End Function 'ArrayDims

Sub Demo_ArrayDims()
    '
    'Demonstrates the functionality of the ArrayDims function using a 1-D, 2-D and 3-D array of various types
    '
    '*************************************************************************************************************
    
    Dim Test2DArray As Variant
    Dim Test3DArray() As Long

    Debug.Print 'Blank line
    Debug.Print ArrayDims(Array(20, 30, 400)) 'Test 1D array
    
    Test2DArray = [{0, 0, 0, 0; "Apple", "Fig", "Orange", "Pear"}]
    Debug.Print ArrayDims(Test2DArray)
    
    ReDim Test3DArray(1 To 3, 0 To 1, 1 To 4)
    Debug.Print ArrayDims(Test3DArray)
End Sub

Answer 3

Change it to

Function fnSafeArrayGetDim(ByRef varRunArray() As Long) As Long
    Dim varTmpArray() As Long
    varTmpArray = varRunArray
    fnSafeArrayGetDim = SafeArrayGetDim(PeekArray(varTmpArray).Ptr)
End Function

You cannot put a Dim TestArray() As Long in a Dim varTmpArray() As Variant what you try here varTmpArray = varRunArray.

If you want to be more generic then use

Function fnSafeArrayGetDim(ByRef varRunArray As Variant) As Long
    Dim varTmpArray As Variant
    varTmpArray = varRunArray
    fnSafeArrayGetDim = SafeArrayGetDim(PeekArray(varTmpArray).Ptr)
End Function

For example:

You cannot put a Long array into a Variant array

Sub ThisDoesNotWork()
    Dim TestArray() As Long
    ReDim TestArray(3, 2)
    
    Dim varTmpArray() As Variant 'with parenthesis
    varTmpArray = TestArray
End Sub

but you can put a Long array into a Variant (that is not an array)

Sub ThisWorks()
    Dim TestArray() As Long
    ReDim TestArray(3, 2)
    
    Dim varTmpArray As Variant 'note this is without parenthesis!
    varTmpArray = TestArray
End Sub

and you can put a Long array into another Long array

Sub ThisWorksToo()
    Dim TestArray() As Long
    ReDim TestArray(3, 2)
    
    Dim varTmpArray() As Long 'with parenthesis it has to be the same type as TestArray
    varTmpArray = TestArray
End Sub