CopyMemory 导致 MS ACCESS 崩溃 - 尝试检索对 IRibbonUI ribbon 的引用

Question

有一个已知问题 在失去对 IRibbonUI 功能区对象的引用之后， 无法检索对它的引用。 唯一的方法是重新启动应用程序 （我说的是 MS Access）

Rory A.（大约 12 年前...）提出了在 MS Excel 中绕过此问题的想法。 可以看到here.

我所做的，不是将对对象的引用保存在 Excel 表格单元格中，而是简单地将其保存在表格中。 当涉及到尝试将引用复制回访问对象的代码行时，它会导致应用程序崩溃。 函数 RetrieveObjRef 在失去对 ribbon 的引用后被调用。 为了进行测试，我需要达到我失去对功能区的引用的情况。 我只是点击了 VBA IDE 中的重置按钮。

任何帮助将不胜感激。

我的代码： 模块 #1 - 我们保存对功能区的引用的原始位置：

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

在模块 #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) ' This line causes application crash!!!'
        Set gobjRibbon = obj
        Set gobjMainRibbon = obj
    End If
    ...
    End Sub

在模块#3

    #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)

我尝试将参考值保存在访问表（“ribbonRef”）中， 我期待如果这对其他许多人有用，为什么它对我不起作用

Answer 1

尝试使用

CopyMemory obj, longObj, LenB(longObj)

- 无需呼叫

Answer 2

我同意@IInspectable 的观点，这个解决方案是有问题的， 虽然这是我目前能得到的最好的， 这对我来说似乎很好。

另外，请看这里Tom van Stiphout的话。

为了那些试图让它工作的人，我在@Ike 和@ErikA 的帮助下在这里写下我的解决方案（但不要忘记@IInspectable 的重要评论！）：

在 Phil.Wheeler 的回答here

的帮助下，我还找到了一种方法来确保我的参考保存在打开 Access 文件的实例

在模块中：

#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

...

Sub StoreObjRef(obj As Object)
    On Error GoTo HandleErr
#If VBA7 Then
    Dim longObj As LongPtr
#Else
    Dim longObj As Long
#End If

longObj = ObjPtr(obj)
If longObj <> Nz(dlookupado("objRef", "ribbonRef", , True), 0) Then
    Call runsqlstr("DELETE * FROM ribbonRef")
    Call runsqlstr("INSERT INTO ribbonRef (objRef) SELECT CStr(" & longObj & ")")

    DoCmd.OpenForm "refFlag", acNormal, , , , acHidden
End If

ExitHere:
    Exit Sub
Resume
HandleErr:
    ...
End Sub
                       
Sub RetrieveObjRef()
' Retrieve the object reference
On Error GoTo HandleErr
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 refFlag form is open then we know that the reference was saved in this opening of Access file
If longObj <> 0 And CurrentProject.AllForms("refFlag").IsLoaded Then
    CopyMemory obj, longObj, LenB(longObj)
    Set gobjRibbon = obj
    Set gobjMainRibbon = obj
End If

ExitHere:
    Exit Sub
Resume
HandleErr:
    ...
End Sub

参考对象设置后存储参考权：

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

    Call StoreObjRef(gobjMainRibbon)
    ...

最后，在我需要的地方使用它：

If gobjMainRibbon Is Nothing Then Call RetrieveObjRef

功能区参考表：

在 MS Access 64 位和 32 位版本上测试。

注意@IInspectable 的评论

重置的不是 IRibbonUI 界面背后的控件，而是您对界面的引用。它是引擎盖下的一个 COM 指针，当它被删除时，它会告诉 COM 服务器您已完成使用该控件，并且如果没有任何其他未完成的引用它，该控件就可以销毁。您的代码确保控件不会被破坏的唯一方法是保持对其接口的引用。

...所以我们可能得到了对内存中相同位置的引用，尽管内存中的那个位置可能会被用于其他东西... 这可能会导致应用程序崩溃...... ...