GetArray

Type SAFEARRAYBOUND
    cElements   As Long      ' # of elements in the array dimension
    lLbound     As Long      ' lower bounds of the array dimension
End Type

Type SAFEARRAY
    cDims       As Integer   ' Count of dimensions in this array.
    fFeatures   As Integer   ' Flags used by the SAFEARRAY routines documented 
                             ' below.
    cbElements  As Long      ' Size of an element of the array.
    cLocks      As Long      ' Number of times the array has been
                             ' locked without corresponding unlock.
    pvData      As Long      ' Pointer to the data.
    rgsabound(1 To 60) As SAFEARRAYBOUND   ' One bound for each dimension.
    ' An array can have max 60 dimensions, only the first cDims items will be 
    ' used
    ' note that rgsabound elements are in reverse order,
    '  e.g. for a 2-dimensional
    ' array, rgsabound(1) holds info about columns, and rgsabound(2) about rows
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
    Any, source As Any, ByVal bytes As Long)
Private Const VT_BYREF = &H4000&

' Fills a SAFEARRAY structure for the supplied array.
'
' The information contained in the SAFEARRAY structure allows
' the caller to identify the number of dimensions and the
' number of elements for each dimension (among other things).
' Element information for each dimension is stored in a
' one-based sub-array of SAFEARRAYBOUND structures (rgsabound).
'
'   TheArray        The array to get information on.
'   ArrayInfo       The output SAFEARRAY structure.
'
'   RETURNS         The number of dimensions of the array
'                   or zero if the array isn't dimensioned

Function GetArrayInfo(TheArray As Variant, ArrayInfo As SAFEARRAY) As Boolean
    Dim lp As Long         ' work pointer variable
    Dim VType As Integer   ' the VARTYPE member of the VARIANT structure

' Exit if no array supplied
    If Not IsArray(TheArray) Then Exit Function

With ArrayInfo
        ' Get the VARTYPE value from the first 2 bytes of the VARIANT structure
        CopyMemory VType, TheArray, 2

' Get the pointer to the array descriptor (SAFEARRAY structure)
        ' NOTE: A Variant's descriptor, padding & union take up 8 bytes.
        CopyMemory lp, ByVal VarPtr(TheArray) + 8, 4

' Test if lp is a pointer or a pointer to a pointer.
        If (VType And VT_BYREF) <> 0 Then
            ' Get real pointer to the array descriptor (SAFEARRAY structure)
            CopyMemory lp, ByVal lp, 4
        End If

' Fill the SAFEARRAY structure with the array info
        ' NOTE: The fixed part of the SAFEARRAY structure is 16 bytes.
        CopyMemory ArrayInfo.cDims, ByVal lp, 16

' Ensure the array has been dimensioned before getting SAFEARRAYBOUND 
        ' Information
        If ArrayInfo.cDims > 0 Then
            ' Fill the SAFEARRAYBOUND structures with the array info
            CopyMemory .rgsabound(1), ByVal lp + 16, _
                ArrayInfo.cDims * Len(.rgsabound(1))

' So caller knows there is information available for the array in 
            ' output SAFEARRAY
            GetArrayInfo = ArrayInfo.cDims
        End If

End With

End Function

Type SAFEARRAYBOUND
cElements As Long ' # of elements in the array dimension
lLbound As Long ' lower bounds of the array dimension
End Type

Type SAFEARRAY
cDims As Integer ' Count of dimensions in this array.
fFeatures As Integer ' Flags used by the SAFEARRAY routines documented
' below.

cbElements As Long ' Size of an element of the array.
cLocks As Long ' Number of times the array has been
' locked without corresponding unlock.

pvData As Long ' Pointer to the data.
rgsabound(1 To 60) As SAFEARRAYBOUND ' One bound for each dimension.
' An array can have max 60 dimensions, only the first cDims items will be

' used

' note that rgsabound elements are in reverse order,

' e.g. for a 2-dimensional

' array, rgsabound(1) holds info about columns, and rgsabound(2) about rows

End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
Any, source As Any, ByVal bytes As Long)
Private Const VT_BYREF = &H4000&

' Fills a SAFEARRAY structure for the supplied array.

'

' The information contained in the SAFEARRAY structure allows

' the caller to identify the number of dimensions and the

' number of elements for each dimension (among other things).

' Element information for each dimension is stored in a

' one-based sub-array of SAFEARRAYBOUND structures (rgsabound).

'

' TheArray The array to get information on.

' ArrayInfo The output SAFEARRAY structure.

'

' RETURNS The number of dimensions of the array

' or zero if the array isn't dimensioned

Function GetArrayInfo(TheArray As Variant, ArrayInfo As SAFEARRAY) As Boolean
Dim lp As Long ' work pointer variable
Dim VType As Integer ' the VARTYPE member of the VARIANT structure

' Exit if no array supplied

If Not IsArray(TheArray) Then Exit Function

With ArrayInfo
' Get the VARTYPE value from the first 2 bytes of the VARIANT structure

CopyMemory VType, TheArray, 2

' Get the pointer to the array descriptor (SAFEARRAY structure)

' NOTE: A Variant's descriptor, padding & union take up 8 bytes.

CopyMemory lp, ByVal VarPtr(TheArray) + 8, 4

' Test if lp is a pointer or a pointer to a pointer.

If (VType And VT_BYREF) <> 0 Then
' Get real pointer to the array descriptor (SAFEARRAY structure)

CopyMemory lp, ByVal lp, 4
End If

' Fill the SAFEARRAY structure with the array info

' NOTE: The fixed part of the SAFEARRAY structure is 16 bytes.

CopyMemory ArrayInfo.cDims, ByVal lp, 16

' Ensure the array has been dimensioned before getting SAFEARRAYBOUND

' Information

If ArrayInfo.cDims > 0 Then
' Fill the SAFEARRAYBOUND structures with the array info

CopyMemory .rgsabound(1), ByVal lp + 16, _
ArrayInfo.cDims * Len(.rgsabound(1))

' So caller knows there is information available for the array in

' output SAFEARRAY

GetArrayInfo = ArrayInfo.cDims
End If

End With

End Function