Binaryworld - The number of dimensions of an array ... [ VB -> Arrays ]

Using "pure" VB, the only way to build a generic routine that returns the number of dimensions of an array passed as an argument is using a loop that repeatedly tests the LBound (o UBound) function until it fails:

Click here to copy the following block

Function ArrayDims(arr As Variant) As Integer
  Dim i As Integer, bound As Long
  On Error Resume Next
  For i = 1 To 60
    bound = LBound(arr, i)
    If Err Then
      ArrayDims = i - 1
      Exit Function
    End If
  Next
End Function

You can write a faster routine by peeking at the memory location where Visual Basic holds the number of dimensions of any array:

Click here to copy the following block

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

Function ArrayDims(arr As Variant) As Integer
  Dim ptr As Long
  Dim VType As Integer

  Const VT_BYREF = &H4000&

  ' get the real VarType of the argument
  ' this is similar to VarType(), but returns also the VT_BYREF bit
  CopyMemory VType, arr, 2

  ' exit if not an array
  If (VType And vbArray) = 0 Then Exit Function

  ' get the address of the SAFEARRAY descriptor
  ' this is stored in the second half of the
  ' Variant parameter that has received the array
  CopyMemory ptr, ByVal VarPtr(arr) + 8, 4

  ' see whether the routine was passed a Variant
  ' that contains an array, rather than directly an array
  ' in the former case ptr already points to the SA structure.
  ' Thanks to Monte Hansen for this fix

  If (VType And VT_BYREF) Then
    ' ptr is a pointer to a pointer
    CopyMemory ptr, ByVal ptr, 4
  End If

  ' get the address of the SAFEARRAY structure
  ' this is stored in the descriptor

  ' get the first word of the SAFEARRAY structure
  ' which holds the number of dimensions
  ' ...but first check that saAddr is non-zero, otherwise
  ' this routine bombs when the array is uninitialized
  ' (Thanks to VB2TheMax aficionado Thomas Eyde for
  ' suggesting this edit to the original routine.)
  If ptr Then
    CopyMemory ArrayDims, ByVal ptr, 2
  End If
End Function