Public Declare PtrSafe Sub Mem_Copy Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef Destination As Any, _
    ByRef Source As Any, _
    ByVal Length As Long)
  
' Platform-independent method to return the full zero-padded
' hexadecimal representation of a pointer value
Function HexPtr(ByVal Ptr As LongPtr) As String
    HexPtr = Hex$(Ptr)
    HexPtr = String$((PTR_LENGTH * 2) - Len(HexPtr), "0") & HexPtr
End Function
 
Public Function Mem_ReadHex(ByVal Ptr As LongPtr, ByVal Length As Long) As String
    Dim bBuffer() As Byte, strBytes() As String, i As Long, ub As Long, b As Byte
    ub = Length - 1
    ReDim bBuffer(ub)
    ReDim strBytes(ub)
    Mem_Copy bBuffer(0), ByVal Ptr, Length
    For i = 0 To ub
        b = bBuffer(i)
        strBytes(i) = IIf(b < 16, "0", "") & Hex$(b)
    Next
    Mem_ReadHex = Join(strBytes, "")
End Function
 
Sub ExampleForScalar()
 
Dim lngValue As Long
     
lngValue = 100
    
lng_VarPtr = VarPtr(lngValue)
    
    Debug.Print "lngValue : 0x"; HexPtr(lng_VarPtr); _
                 " : 0x"; Mem_ReadHex(lng_VarPtr, 4)
      
End Sub
 
Sub ValueIsGone()
 Debug.Print "lngValue : 0x"; HexPtr(lng_VarPtr); _
                 " : 0x"; Mem_ReadHex(lng_VarPtr, 4)
End Sub

Function ObjectFromPointer(lPtr As Long) As Object
     Dim oTemp As Object
     
     Mem_Copy oTemp, lPtr, 4
     Set ObjectFromPointer = oTemp
End Function
  
Sub ExampleForObject()
Dim objRange As Object
     
Set objRange = Sheets(1).Range("A1")
    
lng_ObjPtr = ObjPtr(objRange)
                     
'Set objRange = Nothing
    
End Sub
  
Sub ObjectIsGone()
Dim objRecover As Object
  
     Set objRecover = ObjectFromPointer(lng_ObjPtr)
  
End Sub