Public Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" ( _
   pDest As Any, _
   pSrc As Any, _
   ByVal ByteLen As Long)

Public Function GetArrayDimensions( _
  ByVal arrPtr As Long) As Integer
   Dim address As Long
   
   CopyMemory address, ByVal arrPtr, ByVal  4 

   If address <>  0  Then
      CopyMemory GetArrayDimensions, ByVal address,  2 
   End If
End Function

Public Function VarPtrArray(arr As Variant) As Long
   CopyMemory VarPtrArray, ByVal VarPtr(arr) +  8 , ByVal  4 
End Function

Public Sub TestArray()
    Dim intDimensions As Integer
    Dim avarItems( 1  To  2 ,  1  To  3 ,  1  To  4 ) As Variant

    intDimensions = GetArrayDimensions(VarPtrArray(avarItems))
   
    If intDimensions >=  1  Then
       MsgBox "Массив содержит " & intDimensions & " измерений."
    Else
       MsgBox "Массив не инициализирован."
    End If
End Sub