CopyMemory致MS Access崩溃：IRibbonUI ribbon引用恢复失败

MS Access中存在已知问题：丢失IRibbonUI对象引用后无法重新获取，只能重启应用。参考12年前Rory A.提出的Excel绕过方案，尝试将引用存储到Access表中，但执行CopyMemory恢复引用时导致应用崩溃。测试时通过点击VBA IDE的重置按钮模拟引用丢失场景。

现有代码实现 #

模块1：初始保存Ribbon引用 #

Public Sub OnRibbonLoad(ribbon As IRibbonUI)
        ...
        Set gobjRibbon = ribbon
        Set gobjMainRibbon = ribbon
End Sub

模块2：引用存储与恢复逻辑 #

Sub StoreObjRef(obj As Object)
    ...
    Dim strx As String
    #If VBA7 Then
        Dim longObj As LongPtr
    #Else
        Dim longObj As Long
    #End If
    
    longObj = ObjPtr(obj)
    strx = "DELETE * FROM ribbonRef"
    Call runsqlstr(strx)
    
    strx = "INSERT INTO ribbonRef (objRef) SELECT " & longObj
    Call runsqlstr(strx)
    ...
End Sub
                           
Sub RetrieveObjRef()
    ...
    Dim obj As Object
    #If VBA7 Then
        Dim longObj As LongPtr
    #Else
        Dim longObj As Long
    #End If
    longObj = Nz(dlookupado("objRef", "ribbonRef", , True), 0)
    
    If longObj <> 0 Then
        Call CopyMemory(obj, longObj, 4) ' 此行导致应用崩溃!!!'
        Set gobjRibbon = obj
        Set gobjMainRibbon = obj
    End If
    ...
End Sub

模块3：CopyMemory声明 #

#If VBA7 Then
    Public Declare PtrSafe Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal length As LongPtr)
#Else
    Public Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal length As Long)
#End If

模块4：调用逻辑 #

If gobjMainRibbon Is Nothing Then
    Call RetrieveObjRef
End If

Call StoreObjRef(gobjMainRibbon)

问题根源 #

崩溃的核心原因有两点：

1. 内存地址长度不匹配：在VBA7（64位Office）环境下，LongPtr是8字节，但代码中硬编码CopyMemory的长度为4，仅写入一半指针地址，直接破坏对象内存结构引发崩溃。
2. 无效内存地址访问：VBA IDE执行重置后，原IRibbonUI对象的内存已被回收，此时存储的指针地址变为无效，即使长度正确，恢复操作也会触发内存访问错误。

修复方案 #

1. 动态适配指针长度 #

修改RetrieveObjRef中的CopyMemory调用，根据VBA版本自动获取指针长度，避免硬编码：

Sub RetrieveObjRef()
    ...
    Dim obj As Object
    #If VBA7 Then
        Dim longObj As LongPtr
        Dim ptrLength As LongPtr: ptrLength = LenB(longObj)
    #Else
        Dim longObj As Long
        Dim ptrLength As Long: ptrLength = LenB(longObj)
    #End If
    longObj = Nz(dlookupado("objRef", "ribbonRef", , True), 0)
    
    If longObj <> 0 Then
        Call CopyMemory(obj, longObj, ptrLength)
        Set gobjRibbon = obj
        Set gobjMainRibbon = obj
    End If
    ...
End Sub

2. 增加错误捕获与无效指针处理 #

针对内存地址失效的情况，通过错误捕获机制避免崩溃，并提示用户：

Sub RetrieveObjRef()
    ...
    If longObj <> 0 Then
        On Error Resume Next
        Call CopyMemory(obj, longObj, ptrLength)
        If Err.Number = 0 Then
            Set gobjRibbon = obj
            Set gobjMainRibbon = obj
        Else
            MsgBox "Ribbon引用无法恢复，请重启Access", vbExclamation
        End If
        On Error GoTo 0
    End If
    ...
End Sub

3. 替代方案：封装Ribbon回调逻辑 #

若指针恢复方案仍不稳定，可改为封装Ribbon操作逻辑到类模块，避免直接操作内存指针：

• 创建类模块clsRibbonHandler，在OnRibbonLoad时传入IRibbonUI实例并保存。
• 将需要调用的Ribbon方法（如Invalidate）封装为类的公共方法。
• 存储类实例的引用（而非原始指针），减少内存操作风险。

内容的提问来源于stack exchange，提问作者Oriel Tzvi Shaer