Option Explicit
Option Base 1

Declare Function VarPtr Lib "msvbvm60" (variable As Any) As Long
Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
Declare Function PutMem2 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValue As Long) As Long
Declare Function PutMem4 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValue As Long) As Long
Declare Function GetMem2 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
Declare Sub CopyMem Lib "kernel32" Alias _
                "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
            
Private Type SAFEARRAYBOUND
      cElements As Long    'Количество элементов в размерности
      lLBound As Long      'Нижняя граница размерности
End Type

Private Type SAFEARRAY
      cDims As Integer     'Число размерностей
      fFeatures As Integer 'Флаг, юзается функциями SafeArray
      cbElements As Long   'Размер одного элемента в байтах
      cLocks As Long       'Сколько раз массив был locked, но пока не unlocked.
      pvData As Long              'Указатель на данные.
      rgsabound As SAFEARRAYBOUND 'Повторяется для каждой размерности.
End Type

Private Function SafeArrayOf(ByRef arrVarRef As Variant) As SAFEARRAY
'Извлекает дескриптор матрицы
        Call CopyMem(SafeArrayOf, ByVal SafeArrayPtr(arrVarRef), 24)
End Function

Public Function SafeArrayPtr(ByRef arrVarRef As Variant) As Long
'Возвращает адрес дескриптора матрицы
Const VT_BYREF = &H4000
Dim dWord(4) As Long
        If Not IsArray(arrVarRef) Then Exit Function

        Call CopyMem(dWord(1), arrVarRef, 16) 'разбираем Variant на 4-байтовые куски
        SafeArrayPtr = dWord(3)
        If dWord(1) And VT_BYREF Then _
            GetMem4 SafeArrayPtr, VarPtr(SafeArrayPtr) 'SafeArrayPtr = SafeArrayPtr(1)
End Function