Dim VarVariant as variant
 
 

 
Dim VarVariantDest() as variant
 
 

 
Option Explicit
Option Base 0
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SafeArrayAccessData Lib "Oleaut32" _
        (ByVal psa As Long, pvData As Long) As Long
Private Declare Function SafeArrayUnaccessData Lib "Oleaut32" _
        (ByVal psa As Long) As Long
'   //  msvbvm60.DLL
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" _
    (Var() As Any) As Long
 
Private Sub Test_Translate()
    Dim VarVariant          As Variant
    Dim VarVariantDest()    As Variant
    Dim aaa(0 To 3)         As Variant
    Dim psa                 As Long
    Dim pData               As Long
 
    aaa(0) = "Miguel"
    aaa(1) = "Angel"
    aaa(2) = "Ortega"
    aaa(3) = "Avila"
 
    VarVariant = aaa
 
    ReDim Preserve VarVariantDest(0 To 7)
    CopyMemory psa, ByVal VarPtr(VarVariant)+8, 4
 
    If SafeArrayAccessData(psa, pData) = 0 Then   ' Bloqueo el Array y obtengo el puntero de varptr(VarVariant(0))
        CopyMemory VarVariantDest(4), ByVal pData, 4 * 16  ' Copio el Contenido
        SafeArrayUnaccessData psa  ' Desbloqueo el array
    End If
 
    For psa = LBound(VarVariantDest) To UBound(VarVariantDest)
        Debug.Print psa, VarVariantDest(psa)
    Next psa
End Sub
 
Private Sub Form_Load()
Dim i       As Byte
    For i = 1 To 10
        Call Test_Translate
        MsgBox "Prueba: " & i
    Next i
End Sub