Безопасные указатели

#If Win64 Then
    Const ptrSz As LongPtr = 8
    Const varSz As LongPtr = 24
#Else
    #If Not VBA7 Then
        Private Enum LongPtr
            [_]
        End Enum
    #End If
    Const ptrSz As LongPtr = 4
    Const varSz As LongPtr = 16
#End If
Private Declare PtrSafe Function ArrPtr Lib "VBE7" Alias "VarPtr" (var() As Any) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, Optional ByVal Length As LongPtr = ptrSz)
Private Type tpVariant
    vt As Integer
    r1 As Integer
    r2 As Integer
    r3 As Integer
    pt As LongPtr
    r4 As LongPtr
End Type
Private Enum vt
    VT_RefInt = &H4002 '16386
    VT_RefLng = &H4003 '16387
    VT_RefSng = &H4004 '16388
    VT_RefDbl = &H4005 '16389
    VT_RefCur = &H4006 '16390
    VT_RefStr = &H4008 '16392
    VT_RefByt = &H4011 '16401
    VT_RefLngLng = &H4014 '16404
#If Win64 Then
    VT_RefPtr = VT_RefLngLng
#Else
    VT_RefPtr = VT_RefLng
#End If
End Enum
 
Private blInit As Boolean
Private vLnk(1)
 
Sub Пример()
    If Not blInit Then
        InitVarLink vLnk(0), vLnk(1), VT_RefInt
        blInit = True
    End If
    testtest vLnk(0), vLnk(1)
End Sub
 
Sub testtest(ByRef vPtr1 As Variant, ByRef vPtr2 As Variant)
    Dim s$
    
    s = "abcd"
    
    vPtr1 = StrPtr(s) + 2 * 2 'установка указателя на 3 буву в строке s
    
    Stop
End Sub
 
Sub InitVarLink(v1, v2, tp%)
    MakeVarLink 0, v2, tp                     'создание вариантной ссылки нужног типа
    MakeVarLink VarPtr(v2) + 8, v1, VT_RefPtr 'создание ссылки на указатель первой (v2) ссылки
End Sub
Sub MakeVarLink(ByVal ptr As LongPtr, ByRef vLnk As Variant, ByVal vt As Integer)
    Dim tpVar As tpVariant
    tpVar.vt = vt
    tpVar.pt = ptr
    CopyMemory vLnk, tpVar, varSz
End Sub

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Type tpLongPtr
    lp As Long
End Type
 
Sub testSwapString()
    Dim s1$, s2$
    s1 = "Hello"
    s2 = "World"
    SwapString s1, s2
    Debug.Print s1; " "; s2
End Sub
Private Sub SwapString(s1$, s2$)
    SwapString_ s1, s2
End Sub
Private Sub SwapString_(s1$, s2$, Optional lp1 As Long, Optional ByVal lp0 As Long)
    Static pRef1 As tpLongPtr
    Static pRef2 As tpLongPtr
    Dim i&, blOk As Boolean
    
    If pRef1.lp > 1 Then
    Else
        'устанавливаем ByRef указатель pRef1 на ByRef указатель lp1
        lp1 = VarPtr(pRef1)
        For i = 4 To 128 Step 4
            CopyMemory lp0, ByVal VarPtr(pRef1) - i, 4
            If lp0 = lp1 Then
                blOk = True
                Debug.Print i
                CopyMemory ByVal VarPtr(pRef1) - i, VarPtr(lp0) - 4, 4
                Exit For
            End If
        Next
        If Not blOk Then
            MsgBox "Не удалось найти указатеь pRef1"
            Exit Sub
        End If
    End If
    lp0 = StrPtr(s1)
    pRef1.lp = VarPtr(s1)
    lp1 = StrPtr(s2)
    pRef1.lp = VarPtr(s2)
    lp1 = lp0
End Sub