vba - GetObject 有时会生成新的 COM+/OLE 对象，而不是获取现有的对象

Question

在 Excel 中，我正在连接 Glink OLE 对象 - 此对象是我需要与之交互的正在运行的程序，因此该程序将(并且必须)在运行此代码之前已经打开。

由于(我假设)本地配置超出我的范围或某些我不理解的 API 行为，有时代码会创建一个新对象而不是 Get -ing 已经打开的那个。就其本身而言，这并不是最糟糕的事情——它可以解决。

如果我手动运行 Sub如果不包含任何循环或枚举尝试，我可能会钩住打开的对象(正确)或生成相同类型的新的、不可用的对象(错误)。如果我挂错了，只需重新运行 Sub给了我正确的对象-这是一致的。

如果我运行 Sub循环自身(试图通过手动重新运行子来复制行为)，没有这样的运气 - 它给了我“相同”的对象(不是真正的相同对象 - 它每次都会产生一个新实例，但无论如何这永远不会是正确的对象，因为正确的对象已经存在)一遍又一遍。

我有一些代码:

Dim gl As Glink.Auto
Set gl = Nothing
Set gl = GetObject("", "Glink.Auto")

这就像上面第 2 段中所概述的那样工作 - 它会可靠地在我不需要/不能使用的一些对象和我想要的对象之间交替，所以通过运行宏来发现正确的对象是微不足道的1 或 2 次，具体取决于第一次运行的结果。

有两种方法可以区分我是否得到了正确的对象:第一种是检查 Instance属性，所以我的代码包括一个检查:

Debug.Print gl.Instance

如果我有正确的对象， Instance将是 0 .相反，如果 Instance是 0 以外的任何内容，我得到了一些无法使用的东西。

第二个是 Automated .如果这是 TRUE ，该对象是通过 OLE 生成的(因此对我来说无法使用)。反之，如果是 FALSE ，我知道它指的是我手动打开的对象(这是我想要的对象)。

最终代码

设置 strict至 TRUE启用循环。手动运行和程序循环运行在代码上没有区别，除了标记为手动的运行有 strict = False而其他人有 strict = True .

' Glink globals
Global gl As glink.Auto
Global scr As IAutoScreen

' Other globals
Global dbg As Boolean
Global strict As Boolean

Sub Glink_Initialize()

    Dim retryCount As Integer
    retryCount = 0

    dbg = True
    strict = False

    ' Start GLINK session hook
Retry:
    Set gl = Nothing
    Set gl = GetObject("", "Glink.Auto")

    If dbg = True Then
        If Err.Number <> 0 Then
            GoTo Terminate:
        Else
            If gl.Instance <> 0 And strict = True Then
                If retryCount < 5 Then
                    If dbg = True Then
                        Debug.Print "No valid instance found, retrying."
                        Debug.Print "Instance: " & gl.Instance & " RetryCount: " & retryCount & vbCr
                    End If
                    retryCount = retryCount + 1
                    GoTo Retry:
                ElseIf strict = True Then
                    If dbg = True Then Debug.Print "RetryCount exceeded limit"
                    GoTo Terminate:
                End If
            End If

            Debug.Print "Image: " & gl.Caption & vbCr & "Instance: " & gl.Instance & vbCr & "Automation: " & gl.Automated
        End If
    End If
    ' End GLINK session hook

    Exit Sub
Terminate:
    Debug.Print "No Glink detected! Terminating."
    Set gl = Nothing
End Sub

以下是来自两个手动运行(无循环)的一些调试语句

' Run 1
Image: GLINK - (ref.:2242.2853:ErgoIntegration)
Instance: 49     ' <-- Unusable object
Automation: True ' <-- Spawned by OLE

' Run 2
Image: GLINK - Vegard - AA90        
Instance: 0       ' <-- Usable object
Automation: False ' <-- Not spawned by OLE = this is the object I want

这个过程以绝对一致的方式重复着自己，令人作呕。获取正确的对象、生成新对象、获取正确的对象、生成新对象等:

Image: GLINK - (ref.:2242.2853:ErgoIntegration)
Instance: 56
Automation: True

Image: GLINK - Vegard - AA90
Instance: 0
Automation: False

Image: GLINK - (ref.:2242.2853:ErgoIntegration)
Instance: 57
Automation: True

Image: GLINK - Vegard - AA90
Instance: 0
Automation: False

Image: GLINK - (ref.:2242.2853:ErgoIntegration)
Instance: 58
Automation: True

Image: GLINK - Vegard - AA90
Instance: 0
Automation: False

以下是包含循环 的 1 次运行代码的调试语句

No valid instance found, retrying.
Instance: 43 RetryCount: 0

No valid instance found, retrying.
Instance: 44 RetryCount: 1

No valid instance found, retrying.
Instance: 45 RetryCount: 2

No valid instance found, retrying.
Instance: 46 RetryCount: 3

No valid instance found, retrying.
Instance: 47 RetryCount: 4

所以似乎使用编程循环跳过了获取正确对象的步骤......为什么？有没有办法来解决这个问题？

Answer 1

根据@Flephal 的评论和 MSDN , 有人会认为省略 GetObject 的第一个参数将是正确的方法。出于某种原因，我并没有始终如一地遇到这种情况 - 如果第一个参数不存在，有时我会收到 429 错误。

更具体地说，这是 MSDN 的摘录:

If pathname is a zero-length string (""), GetObject returns a new object instance of the specified type. If the pathname argument is omitted, GetObject returns a currently active object of the specified type. If no object of the specified type exists, an error occurs.

根据这个描述，我假设我得到了引用的错误，因为没有找到指定的对象(但我正在查看它的窗口，所以我知道它在那里)。我不知道为什么会这样，但是:

解决方法

改变这个:

Set gl = Nothing
Set gl = GetObject("", "Glink.Auto")

对此:

Set gl = Nothing
Set gl = GlinkObjectHook

并添加此功能:

Function GlinkObjectHook() As glink.Auto
    Dim glink As glink.Auto
    On Error Resume Next
    Set glink = GetObject(, "Glink.Auto")
    On Error GoTo 0
    If glink Is Nothing Then Set glink = GetObject("", "Glink.Auto")
    Set GlinkObjectHook = glink
End Function