Mathieu Trentesaux
Mathieu Trentesaux

Reputation: 41

Collection of Access applications currently opened

I need to be able to list all current Access applications. The GetObject command is well thought out, but it is not very efficient when it comes to simultaneously processing batches of read/write accdb files and ensure that there is only one Access instance per file. I found approaches to my problem in some rare places on the Net and I was actually able to tinker with exactly what I needed.

But my solution has some rather strange and annoying side effects: when I use it, Access instances don't really close but get invisible while keeping applications opened: I can't even make them visible again with .Visible= True, the action just don't work and I must kill them by hand. I have even seen remaining Access instances mixing in the task manager with the Excel instance Workbooks...

The fact is that I have very little knowledge of the Windows APIs that it implements: it's by chance if my solution works.

So I'm asking you here to help me finalize this code that does a simple thing, return a collection of Applications Access objects currently opened.

Here is the code:

Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As LongPtr, ByVal dwId As Long, riid As UUID, ppvObject As Object) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long
Private Type UUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(7) As Byte
End Type
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0

Public Function AccessInstances() As Collection
Dim hWndDesk As LongPtr, hWnd As LongPtr
Dim iid As UUID, obj As Object
Dim acApp As Access.Application
    Set AccessInstances = New Collection
    hWndDesk = GetDesktopWindow
    Do
        hWnd = FindWindowEx(hWndDesk, hWnd, "OMain", vbNullString)
        Call IIDFromString(StrPtr(IID_IDispatch), iid)
        If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, obj) = 0 Then
            Set acApp = obj
            AccessInstances.Add acApp
        End If
    Loop Until hWnd = 0
    Set acApp = Nothing
End Function

The command that triggers the problems is AccessibleObjectFromWindow. I understand that there is an intermediate FindWindowEx call to do before invoking this command, but I ignore how it must be done, this totally out of my scope.

I thought that the Application Objects reserved by the collection could be what forces the application to stay open, but I never use them in a static or module level private variable, which implies that they are necessarily set to Nothing when the program stops, whether I do it myself explicitly or not, like in this example:

Sub ListAccessInstances()
Dim acApp As Access.Application
    For Each acApp In AccessInstances
        Debug.Print acApp.Name
    Next
End Sub

Edit / additional information :

I was able to highlight the seemingly systematic problem that the function produces.

The principle is that the function produces side effects that do not exist when it is not used: Access instances remain open. A question that arises is whether or not these instances are empty. It seems to me that closing the last instance will totally close this leftover, but I am still uncertain when this may depend on the answer to the previous question.

The test procedure I have used is two-stage. A first procedure located in an Access database opens with the Shell command about ten other Access databases and a second one closes them (Getobject(aFile).Quit) . Thus an Access database remains always open.

The test consists in using or not using the incriminated function between the two procedures and to note what differs in the application manager, and also in the result of the function itself. This test is considered successful if there is no other instance left than the current one having used this function between the openings and closings. I remind you that this function is supposed to be purely readable and therefore without any consequence on the system.

1°) The test described above is generally positive: the instances are cleaned after they are closed. Nevertheless, I still saw one or two of them dragging.

2°) When you close the bases manually instead of using the closing procedure, the instances remain. Alexandru, could you try this test and tell me if you observe the same thing?

This is the demonstration, whose reproducibility I don't know yet, that the function does produce a system malfunction. In real work I had noticed that sometimes some instances still had their base (CurrentDb) open under the conditions I have described: locked in their invisibility. In fact, other visible effects in the task manager occur more or less randomly. For example to have an open and functional Access instance that does not appear in the task manager.

My approach to build this function has been very empirical. In particular, I learned from a code that allows the same thing with Excel. Since Excel is now mono-instance, I could not test this function, but I assume nevertheless that it is well written and that it works without side effects.

Here is the excerpt of the code we are interested in:

Function GetXLapp(hWinXL As Long, xlApp As Object) As Boolean
Dim hWinDesk As Long, hWin7 As Long
Dim obj As Object
Dim iid As GUID

    Call IIDFromString(StrPtr(IID_IDispatch), iid)
    hWinDesk = FindWindowEx(hWinXL, 0&, "XLDESK", vbNullString)
    hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)
    If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj) = S_OK Then
        Set xlApp = obj.Application
        GetXLapp = True
    End If
End Function

One can see that there are two successive window calls, this is the aspect I shunted in an experiment that was not supposed to work, but it still gave the result I have here. Functional, but producing instability. That's it, my question is whole, should we make this intermediate call with Access and if so how? Is it something else?, etc.

Upvotes: 0

Views: 433

Answers (1)

hiichaki
hiichaki

Reputation: 974

Try this

Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare PtrSafe Function FindWindowExA Lib "User32" (ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr

Public Function getAccessInstanceList() As Collection
  Dim GUID&(0 To 3), acc As Object, hWnd
  GUID(0) = &H20400
  GUID(1) = &H0
  GUID(2) = &HC0
  GUID(3) = &H46000000

  Set getAccessInstanceList = New Collection
  Do
    hWnd = FindWindowExA(0, hWnd, "OMain", vbNullString)
    If hWnd = 0 Then Exit Do
    If AccessibleObjectFromWindow(hWnd, &HFFFFFFF0, GUID(0), acc) = 0 Then
      getAccessInstanceList.add acc.Application
    End If
  Loop
End Function

Upvotes: 1

Related Questions