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

#### Jaafar Tribak

##### Well-known Member
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

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

'\\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)
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
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

'\\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
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

Set oColApps = New Collection
Next i

End Sub

Private Function WeAreExceedingMaxXLInstances() As Boolean

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

Set oNewApp = CreateObject("EXCEL.APPLICATION")
oNewApp.UserControl = True
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

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 autpen 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
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
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

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

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
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
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
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.

Replies
2
Views
176
Replies
3
Views
130
Replies
0
Views
69
Replies
2
Views
424
Replies
4
Views
358

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.

### Which adblocker are you using?

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

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