Can an Excel VBA macro, running in one instance of Excel, access the workbooks of another running instance of Excel? For example, I would like to create a list of all workbooks that are open in any running instance of Excel.
I don't believe this is possible using only VBA because the highest level object you can get to is the Application object which is the current instance of Excel.
I believe that VBA is more powerfull than Charles thinks ;)
As for now I found this code, tested it and it works well!
If there is only some tricky way to point to the specific instance from GetObcject and CreateObject we'll have your problem solved!
EDIT:
If you're the creator of all the instances there should be no problems with things like listing workbooks. Take a look on this code:
Sub Excels()
Dim currentExcel As Excel.Application
Dim newExcel As Excel.Application
Set currentExcel = GetObject(, "excel.application")
Set newExcel = CreateObject("excel.application")
newExcel.Visible = True
newExcel.Workbooks.Add
'and so on...
End Sub
Cornelius' answer is partially correct. His code gets the current instance and then makes a new instance. GetObject only ever gets the first instance, no matter how many instances are available. The question I believe is how can you get a specific instance from among many instances.
For a VBA project, make two modules, one code module, and the other as a form with one command button named Command1. You might need to add a reference to Microsoft.Excel.
This code displays all the name of each workbook for each running instance of Excel in the Immediate window.
'------------- Code Module --------------
Option Explicit
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
Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long
Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long
Type UUID 'GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
'------------- Form Module --------------
Option Explicit
Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Const OBJID_NATIVEOM As Long = &HFFFFFFF0
'Sub GetAllWorkbookWindowNames()
Sub Command1_Click()
On Error GoTo MyErrorHandler
Dim hWndMain As Long
hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
Do While hWndMain <> 0
GetWbkWindows hWndMain
hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)
Loop
Exit Sub
MyErrorHandler:
MsgBox "GetAllWorkbookWindowNames" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub
Private Sub GetWbkWindows(ByVal hWndMain As Long)
On Error GoTo MyErrorHandler
Dim hWndDesk As Long
hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString)
If hWndDesk <> 0 Then
Dim hWnd As Long
hWnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString)
Dim strText As String
Dim lngRet As Long
Do While hWnd <> 0
strText = String$(100, Chr$(0))
lngRet = GetClassName(hWnd, strText, 100)
If Left$(strText, lngRet) = "EXCEL7" Then
GetExcelObjectFromHwnd hWnd
Exit Sub
End If
hWnd = FindWindowEx(hWndDesk, hWnd, vbNullString, vbNullString)
Loop
On Error Resume Next
End If
Exit Sub
MyErrorHandler:
MsgBox "GetWbkWindows" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub
Public Function GetExcelObjectFromHwnd(ByVal hWnd As Long) As Boolean
On Error GoTo MyErrorHandler
Dim fOk As Boolean
fOk = False
Dim iid As UUID
Call IIDFromString(StrPtr(IID_IDispatch), iid)
Dim obj As Object
If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK
Dim objApp As Excel.Application
Set objApp = obj.Application
Debug.Print objApp.Workbooks(1).Name
Dim myWorksheet As Worksheet
For Each myWorksheet In objApp.Workbooks(1).Worksheets
Debug.Print " " & myWorksheet.Name
DoEvents
Next
fOk = True
End If
GetExcelObjectFromHwnd = fOk
Exit Function
MyErrorHandler:
MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function