Access: persist a COM reference across Program Res

2019-08-28 12:38发布

问题:

Are there ways in Access VBA (2003) to cast a COM reference to an integer, and to call AddRef/Release? (which give the error "Function or interface marked as restricted, or the function uses an Automation type not supported in Visual Basic")

I'm using a third-party COM object which doesn't handle being instantiated twice in a single process (this is a known bug). I therefore thought of storing the reference as the caption of a control on a hidden form to protect it from Program Reset clearing all VB variables.

Edit: I think the cast to int can be done with the undocumented ObjPtr, and back again with the CopyMemory API, and AddRef/Release can be called implicitly. But is there a better way? Are add-ins protected from Program Reset?

回答1:

Is the problem with surviving the code reset or is it that once the code is reset it can't be re-initialized?

For the first problem, wrap your top-level object in a function and use a STATIC variable internally to cache the reference. If the STATIC variable Is Nothing, re-initialize. Here's the function I use for caching a reference to the local database:

  Public Function dbLocal(Optional bolInitialize As Boolean = True) +
     As DAO.Database
  ' 2003/02/08 DWF added comments to explain it to myself!
  ' 2005/03/18 DWF changed to use Static variable instead
  ' uses GoTos instead of If/Then because:
  '  error of dbCurrent not being Nothing but dbCurrent being closed (3420)
  '  would then be jumping back into the middle of an If/Then statement
  On Error GoTo errHandler
    Static dbCurrent As DAO.Database
    Dim strTest As String

  If Not bolInitialize Then GoTo closeDB

  retryDB:
    If dbCurrent Is Nothing Then
       Set dbCurrent = CurrentDb()
    End If
    ' now that we know the db variable is not Nothing, test if it's Open
    strTest = dbCurrent.Name

  exitRoutine:
    Set dbLocal = dbCurrent
    Exit Function

  closeDB:
    If Not (dbCurrent Is Nothing) Then
       Set dbCurrent = Nothing
    End If
    GoTo exitRoutine

  errHandler:
    Select Case err.Number
      Case 3420 ' Object invalid or no longer set.
        Set dbCurrent = Nothing
        If bolInitialize Then
           Resume retryDB
        Else
           Resume closeDB
        End If
      Case Else
        MsgBox err.Number & ": " & err.Description, vbExclamation, "Error in dbLocal()"
        Resume exitRoutine
    End Select
  End Function

Anywhere you'd either of these in code:

  Dim db As DAO.Database
  Set db = CurrentDB()
  Set db = DBEngine(0)(0)
  db.Execute "[SQL DML]", dbFailOnError

...you can replace the whole thing with:

  dbLocal.Execute "[SQL DML]", dbFailOnError

...and you don't have to worry about initializing it when your app opens, or after a code reset -- it's self-healing because it checks the Static internal variable and re-initializes if needed.

The only caveat is that you need to make a call with the bolInitialize argument set to False when you shut down your app, as this cleans up the reference so there's no risk of your app hanging when it goes out of scope as the app closes.

For the other problem, I really doubt there's any solution within VBA, unless you can make an API call and kill the external process. But that's something of a longshot, I think.