Ever wished there was an 'Applications' Collection ?!!!

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,306
Office Version
  1. 2016
Platform
  1. Windows
Ok, I admit it, designing a Collection of all the XL applications currently running in one's machine and use it nearly in the same way as other native collections in the XL object model is no doubt of little practical use for most XL users but I 've long wanted to do this if only for the challenge of it as well as for the sake of learning.

This subject was discussed here http://www.mrexcel.com/board2/viewtopic.php?t=185175&highlight=communicating but was abandoned.

Also, let me just say that the method I've attempted here to do this is by no means an elegant robust solution.It's actually just a hack\workaround which also requires quite a bit of setting up and can also be prone to errors if not handled carefully.

For a robust solution, the only way I know of is by registering and using a third party type lib : OLELIB.TLB written in C with which one can get a pointer to every object in the ROT but then again, what we want here is a VBA-Only solution !!


Set Up required - Follow these 2 STEPS :


STEP1- Create a workbook , place the following code in the 'ThisWorkBook' Module , save it as an AddIn and name it : AppsCollection.xla


AddIn Code

Code:
Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private bSkipCloseEvent As Boolean


Private Sub Workbook_Open()

    Dim oWB As Workbook
    Dim lHwnd As Long
    Dim vAddInLocations As Variant
    Dim sMaxInstances As String
    
    '\\check if there is a max allowed # of xl instances
    '\\in the registry
    sMaxInstances = GetSetting("XLInstances", "MaxAllowed", "Max=")
    
    '\\if there is,check how many xl instances are already open
    If Val(sMaxInstances) <> 0 Then
        vAddInLocations = GetAllSettings("MyRunningApps", "AddInLocations")
        
        '\\if this xl instance is going to exceed the allowed #
        '\\then set a flag,inform the user and close it
        If UBound(vAddInLocations, 1) >= Val(sMaxInstances) - 1 Then
            GoTo exitHere
        End If
    End If
    
    
    '\\however,if it's ok to open this instance then see if it is the first one.
    '\\if it is not,save this addin temporarly under a unique name
    '\this will permit to retrieve a pointer to the parent application !
    lHwnd = FindWindow("XLMAIN", Application.Caption)
    If Me.ReadOnly Then
        Me.SaveAs Environ("temp") & Application.PathSeparator & _
        CStr(lHwnd) & "_" & Me.Name
    End If
    
    '\always make an entry in the registry so the addin path
    '\\can be later retrieved by the 'Applications' class
    SaveSetting "MyRunningApps", "AddInLocations", CStr(Me.Name), CStr(Me.FullName)
    Exit Sub
    
    '\\we got here means there are more than the allowed # of instances
    '\\quit and get out now skipping the Before_Close event handler
exitHere:
    bSkipCloseEvent = True
    MsgBox "You have exceed the maximum number of allowed instances", vbExclamation
    Application.Quit

End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)

    '\\if user is closing this xl instance delete its corresponding
    '\\registry entry to indicate it's no longer running
    If bSkipCloseEvent Then Exit Sub
        DeleteSetting "MyRunningApps", "AddInLocations", CStr(Me.Name)
        
        '\\if it's not the first instance delete the associated temp addin
        If Me.Name <> "AppsCollection.xla" Then
        KillMyself Me
    End If

End Sub


Private Sub KillMyself(oWB As Workbook)

    Dim sPathName As String
    
    sPathName = oWB.FullName
    oWB.ChangeFileAccess xlReadOnly
    Kill sPathName
    oWB.Saved = True

End Sub


Now, install this addin before you can use the Class shown in the next step.



STEP2- Create a workbook , add a Class Module to it's VBProject and name the Class : clsAppsCollection.
Place the following code in this Class Module :


Code:
Option Explicit

Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function GetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Const MAX_COMPUTERNAME_LENGTH As Long = 31

Private oColApps As Collection
Private ap As Application
Private byMaxInstances As Byte
Private WithEvents wbCloseEvent As Workbook



Public Property Get Count() As Long

    Call UpdateAppsCollection
    Count = oColApps.Count

End Property


Public Property Let MaximumInstancesAllowed(ByVal vNewValue As Byte)
    '\\store this value in the registry so it can be accessed by all
    '\\other running xl applications
    SaveSetting "XLInstances", "MaxAllowed", "Max=", CStr(vNewValue)
    byMaxInstances = vNewValue

End Property


Public Property Get MaximumInstancesAllowed() As Byte

    MaximumInstancesAllowed = byMaxInstances

End Property


Public Function OpenNew _
(Optional visible As Boolean = True, Optional WBPathName As Variant) As Excel.Application

    Dim sErrMsg As String

    If Not WeAreExceedingMaxXLInstances Then
        '\\if there is 'WBPathName' this xl instance will open it
        If Not IsMissing(WBPathName) Then
            If Len(Dir(WBPathName)) <> 0 Then

                Set OpenNew = OpenNewXLApp(visible, WBPathName)
            Else
            '\\wrong pathname entered ?, warn the user and get out
                sErrMsg = sErrMsg & "Check the spelling of the path name."
                MsgBox "Path name : ' " & WBPathName & " '  not found." & vbCrLf _
                & vbCrLf & sErrMsg, vbExclamation
            End If
        Else
            Set OpenNew = OpenNewXLApp(visible)
        End If
    End If
     
End Function


Public Function Item(NameOrIndex As Variant) As Excel.Application

'\\this routine allows to reference the applications by their index #
'\\or the name of any of its children workbooks for easier use of this proprety

    Dim i As Byte
    Dim oWBk As Workbook
    Call UpdateAppsCollection
    If Not IsNumeric(NameOrIndex) Then
        For i = 1 To oColApps.Count
            For Each oWBk In oColApps(i).Workbooks
                If UCase(oWBk.Name) = UCase(NameOrIndex) Then
                    Set Item = oColApps(i)
                    Exit Function
                End If
            Next oWBk
        Next i
    End If
    Set Item = oColApps(NameOrIndex)

End Function


Public Sub ActivateApp(App As Excel.Application)
    
    '\\this is just a nice convinience
    '\\when you want to quickly activate one
    '\\particular xl instance

    Call UpdateAppsCollection
    If App.visible Then

        App.WindowState = xlMaximized
        AppActivate App.Caption
    End If

End Sub


Public Property Get HostComputer() As String
    
    '\\property similar to the standard Parent prop
    
    Dim lLen As Long
    Dim sBuffer As String
    'Create a buffer
    lLen = MAX_COMPUTERNAME_LENGTH + 1
    sBuffer = Space(lLen)
    'Get the computer name
    GetComputerName sBuffer, lLen
    'get only the actual data
    sBuffer = Left(sBuffer, lLen)
    'Show the computer name
    HostComputer = sBuffer

End Property


Private Sub Class_Initialize()
    'set up the 'Before_Close' event sink
    Set wbCloseEvent = ThisWorkbook

End Sub


Private Sub wbCloseEvent_BeforeClose(Cancel As Boolean)
    '\\make sure we delete the registry entry that
    '\\stores the # of xl instances once the class workbook is closed
    On Error Resume Next
    DeleteSetting "XLInstances"

End Sub


Private Sub UpdateAppsCollection()

    '\\this routine updates the current # of insatnces
    '\\and assigned their respective pointers to the module
    '\\level collection.
    '\\this routine is run every time a member of this class
    '\\is executed. this is vital to keep upto date with
    '\\the changing number of open xl instances.
    
        Dim i As Byte
    Dim vAddInLocations As Variant

    Set oColApps = New Collection
    vAddInLocations = GetAllSettings("MyRunningApps", "AddInLocations")
    For i = LBound(vAddInLocations, 1) To UBound(vAddInLocations, 1)
        oColApps.Add GetObject((vAddInLocations(i, 1))).Parent
    Next i

End Sub


Private Function WeAreExceedingMaxXLInstances() As Boolean

    Dim vAddInLocations As Variant

    vAddInLocations = GetAllSettings("MyRunningApps", "AddInLocations")
    If byMaxInstances <> 0 Then
        If UBound(vAddInLocations, 1) >= byMaxInstances - 1 Then
            WeAreExceedingMaxXLInstances = True
        End If
    End If

End Function


Private Function OpenNewXLApp _
(Optional ByVal bVisible As Boolean = True, Optional ByVal sWBPathName As Variant) As Excel.Application

    Dim oNewApp As Application
    Dim sAddInPathName As String
    
    Set oNewApp = CreateObject("EXCEL.APPLICATION")
    oNewApp.UserControl = True
    sAddInPathName = AddIns("AppsCollection").FullName
    oNewApp.Workbooks.Open sAddInPathName
    Call UpdateAppsCollection
    oNewApp.visible = bVisible
    If Not IsMissing(sWBPathName) Then
        oNewApp.Workbooks.Open sWBPathName
    End If
    Set OpenNewXLApp = oNewApp

End Function

That's it.


Here are two examples you can try once the AddIn has been insatlled & loaded and the Class has been added to your project.

Start a few instances of Excel and run the test routine below :


Example 1

Code:
'In a Standard Module

Option Explicit

Private Applications As clsAppsCollection

Sub Test()

    '\\open a few xl applications instances and
    '\\run this code to create an 'Applications' collection
    '\\and display info about each xl instance
    
    
    Dim App As Excel.Application
    Dim i As Byte, j As Byte
    Dim sMsg As String
    
    Set Applications = New clsAppsCollection
    With Applications
        For i = 1 To .Count
            sMsg = sMsg & " Application:  " & i & vbCrLf
            sMsg = sMsg & "--------------" & vbCrLf
            sMsg = sMsg & " WorkBooks Count:  " & _
            Applications.Item(i).Workbooks.Count & vbCrLf & vbCrLf
            For j = 1 To .Item(i).Workbooks.Count
                With .Item(i).Workbooks(j)
                    sMsg = sMsg & " WorkBook:  " & j & "  Sheets Count : " _
                    & .Sheets.Count & vbCrLf
                End With
            Next j
            sMsg = sMsg & vbCrLf & vbCrLf
        Next i
    End With
    MsgBox sMsg

End Sub


Example 2:


Code:
'In a Standard Module

Option Explicit

Private Applications As clsAppsCollection


Sub Test2()
    '\\allow no more than 3 xl instances @ a time
    '\\and use the OpenNew Method to open one
    
    Set Applications = New clsAppsCollection
    With Applications
        .MaximumInstancesAllowed = 3
        .OpenNew
    End With

End Sub


:eek: A word of caution for anyone trying this code! The code in this project makes use of the Registry to store temporary entries inside the 'VB and VBA program Settings' Key during the AddIn auto_Open event. I believe this is safe but if you happen to edit the code, subtle errors can arise and can be tricky to locate. You may have to manually delete the above temp reg entries by running the RegEdit.exe Applet.

The MaximumInstancesAllowed Property can be particularly troublesome if edited !

Tested in XL 2002 Office XP.

Any feedback would be much appreciated.

Regards.
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,306
Office Version
  1. 2016
Platform
  1. Windows
I know . This somewhat long winded set-up work can put off anyone but has anyone given this a shot ?

I'd like to know if this works for other XL versions ....Any comments\suggestions are welcome.

Regards.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,306
Office Version
  1. 2016
Platform
  1. Windows
Not very popular this one - isn't it? :(

Regards.
 
L

Legacy 98055

Guest
Jaafar, there are several classes in the Net framework that allow you to enumerate instances in the running object table. We discussed this in one of your previous posts. It utilizes a handful of API functions. I have yet to see an example in VB 6. Maybe you can figure it out.

Declare Sub GetRunningObjectTable Lib "ole32.dll" ( _
ByVal reserved As Long, _
ByVal pprot As Long)

Private Declare Sub CreateBindCtx Lib "ole32.dll" ( _
ByVal reserved As Long, _
ByVal ppbc As Long)
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,306
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Thanks Tom.

As you said, I have yet to see an example in VB. I've searched the web up & down for this before and I have asked in VB forums but without any luck.That's why I came up with thIS hack that uses an AddIn and which does work as expected in my machine.

I experimented with those APIs but can't get them to work either.

What XL Ver are you running ? Did you try my code ?

Regards.
 

Jon Peltier

MrExcel MVP
Joined
May 14, 2003
Messages
4,968
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
I used a much smaller bit of code in a utility that checked all running instances of Access. It would not be a major enhancement to look for Excel instances and put each into a collection.

It was a couple years ago, so it's not right on my fingertips. But if there's interest, I'll look for it.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,306
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Hi Jon,

Do you refer to the Process-ID\Instance or to the Window Handle of each running XL instance ?

If so, that's not what we need here . What we want to put in the collection is a POINTER to each running application so that we can access each object in each of them via AUTOMATION.

Putting the ProcessID or Window Handle in a collection is much easier to do but cannot be used to refer to and automate the applications.

Regards.
 

Jon Peltier

MrExcel MVP
Joined
May 14, 2003
Messages
4,968
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Jaafar -

As I said, it was a while ago. But we had to find which instance was using a certain instance, then use automation to access that instance. So presumably it would do what you need. I guess I'll have to check.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,306
Office Version
  1. 2016
Platform
  1. Windows
Jaafar -

As I said, it was a while ago. But we had to find which instance was using a certain instance, then use automation to access that instance. So presumably it would do what you need. I guess I'll have to check.

Thanks Jon.

I woul'd love to see how\if that could be applied to XL.

Regards.
 

Jon Peltier

MrExcel MVP
Joined
May 14, 2003
Messages
4,968
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
On closer inspection, the utility I'd been using cycled through all desktop windows, and when it found one with an appropriate string in its title, it activated that window (AppActivate). If none was found, it shelled the appropriate process. After this the utility closed and the window was available for the user.

The problem in this case with trying to automate the process was that if a dialog was open in the application, GetObject wouldn't see it, and it would create a second window using the same DB.

I'm sorry to get your hopes up. Our utility started out to do what you want, but we had to use a different approach.
 

Forum statistics

Threads
1,141,094
Messages
5,704,304
Members
421,337
Latest member
DeuxMilleSangue

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top