Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(hpvDest As Any, _
hpvSource As Any, _
ByVal cbCopy As Long)



Function IsVariantEmpty(varVar As Variant) As Boolean

 'проверяет полученную переменную на "пустоту" 
 'возвратит истину для неинициализированного массива, 
 'объектной переменной значение которой Is Nothing 
 'или неинициализированного варианта 

  If IsArray(varVar) Then
    Dim lngArrAddress As Long, saPtr As Long
     'получаем указатель на элемент данных 
    CopyMemory lngArrAddress, ByVal VarPtr(varVar) +  8 ,  4 
    
    'получаем адрес описателя массива 
    ' для неинициализированного массива он всегда будет 0 
   CopyMemory saPtr, ByVal lngArrAddress,  4 
   
   IsVariantEmpty = saPtr =  0 
  ElseIf IsObject(varVar) Then
    IsVariantEmpty = (varVar Is Nothing)
  Else
    IsVariantEmpty = IsEmpty(varVar)
  End If
End Function

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(hpvDest As Any, _
hpvSource As Any, _
ByVal cbCopy As Long)


Type SAFEARRAY
  cDims As Integer      'число рамерностей в массиве 
  fFeatures As Integer  'св-ва типа являются ли данные указателями на строки, объекты, варианты или представляют собой непрерывный массив данных 
  cbElements As Long    'размер одного элемента в байтах 
  cLocks As Long        ' 
  pvData As Long        'указатель на данные 
End Type


Function IsVariantEmpty(varVar As Variant) As Boolean

 'проверяет полученную переменную на "пустоту" 
 'возвратит истину для неинициализированного массива, 
 'объектной переменной значение которой Is Nothing 
 'или неинициализированного варианта 

  If IsArray(varVar) Then
    Dim lngArrAddress As Long, saPtr As Long
     'получаем указатель на элемент данных 
    CopyMemory lngArrAddress, ByVal VarPtr(varVar) +  8 ,  4 
    
    'получаем адрес описателя массива 
    ' для неинициализированного массива он всегда будет 0 
   CopyMemory saPtr, ByVal lngArrAddress,  4 
   If saPtr <>  0  Then
     Dim arDesc As SAFEARRAY  ' 1D 
     CopyMemory ByVal VarPtr(arDesc), ByVal lngArrAddress, Len(arDesc)
     IsVariantEmpty = arDesc.pvData =  0 
   Else
     IsVariantEmpty = True  'saPtr = 0 
   End If
  ElseIf IsObject(varVar) Then
    IsVariantEmpty = (varVar Is Nothing)
  Else
    IsVariantEmpty = IsEmpty(varVar)
  End If
End Function