application.windows object

[jcsabi]

Hello,

There are 2 separate Excel application windows. First one contains "Excel1.xlsx" and "Excel2.xlsx" and the second application window contains "Excel3.xlsm" and "Excel4.xlsx". In the VBA code of "Excel3.xlsm" - How do I copy "Excel1.xlsx".Sheet1.Range("A1") to "Excel3.xlsm".Sheet1.Range("A1")?
My only way to open "Excel1.xlsx" for read only in the same, second application window for the copy process. Is there a simple solution?


Sub Collects()
If Workbooks("Excel1.xlsx") Is Nothing Then Workbooks.Open Filename:="Excel1.xlsx"
Application.Workbooks("Excel3.xlsm").Worksheets("Sheet1").Activate
Range("A1")=Workbooks("Excel1.xlsx").Worksheets("Sheet1").Range("A1")
End Sub

[Leith Ross]

Hello jcsabi,

The macro "GetWorkbookByName" will return an object reference to the workbook you want. This searches the user's desktop for all open instances of Excel and checks the workbooks for a match. When a match is found the macro returns an object reference you can use in your code to access the workbook.

Add a new VBA Module to your workbook and paste the code below into it.



' Written: September 11, 2017
' Author: Leith Ross
' Summary: Searches all open instances of Excel on the user's desktop
' for a workbook matching the given nam. When a match is found
' an object reference to the workbook is returned. If no match
' is found then the value returned is Nothing.




Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0


Type GUID
lData1 As Long
iData2 As Integer
iData3 As Integer
aBData4(0 To 7) As Byte
End Type


Private Declare PtrSafe Function IIDFromString _
Lib "ole32.dll" _
(ByVal lpszIID As String, _
ByRef lpIID As GUID) _
As Long


Private Declare PtrSafe Function FindWindowEx _
Lib "user32.dll" Alias "FindWindowExA" _
(ByVal hWnd1 As LongPtr, _
ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) _
As LongPtr

Private Declare PtrSafe Function AccessibleObjectFromWindow _
Lib "oleacc.dll" _
(ByVal hWnd As LongPtr, _
ByVal dwId As Long, _
ByRef riid As GUID, _
ByRef ppvObject As Object) _
As Long

Function GetWorkbookByName(ByVal wkbName As String) As Object


Dim CLSID As String
Dim IDisp As GUID
Dim n As Long
Dim ret As Long
Dim xlDesk As LongPtr
Dim xlHwnd As LongPtr
Dim xlWkb As LongPtr
Dim Wnd As Object
Dim Wkb As Workbook
Dim XLapp As Excel.Application

If wkbName = "" Then
MsgBox "Workbook Name Is Missing", vbExclamation
Exit Function
End If

CLSID = StrConv("{00020400-0000-0000-C000-000000000046}", vbUnicode)
ret = IIDFromString(CLSID, IDisp)

Do
xlHwnd = FindWindowEx(0, xlHwnd, "XLMAIN", vbNullString)
If xlHwnd = 0 Then Exit Do

xlDesk = FindWindowEx(xlHwnd, 0&, "XLDESK", vbNullString)
xlWkb = FindWindowEx(xlDesk, 0&, "EXCEL7", vbNullString)

If xlWkb <> 0 Then
ret = AccessibleObjectFromWindow(xlWkb, OBJID_NATIVEOM, IDisp, Wnd)
If ret = 0 Then
Set XLapp = Wnd.Parent.Parent
For n = 1 To XLapp.Workbooks.Count
Set Wkb = XLapp.Workbooks(n)
If Wkb.Name = wkbName Then
Set GetWorkbookByName = Wkb
Exit Function
End If
Next n
End If
End If
Loop

End Function


Your code, based on what you posted, will look like this after the macro has been added...


Sub Collects()


Dim Wkb As Workbook

Set Wkb = GetWorkbookByName("Excel1.xlsx")

If Not Wkb Is Nothing Then
ThisWorkbook.Worksheets("Sheet1").Range("A1").Value = Wkb.Worksheets("Sheet1").Range("A1").Value
End If


End Sub

[jcsabi]

Dear Leith Ross,

Genious! I tought it needs some dlls, and really. Look, in that case when:

"Excel1.xlsx" already opened
the file size of "Excel1.xlsx" is more MBs and to reopen it from a network is more time,
the user open the "Excel3.xlsm" from the Windows Explorer, sometimes it opening in a different Excel application window

it needs your solution. Thanks, I'm very apprechiated!

best regards,
Csaba Janossy

[Leith Ross]

Hello jcsabi,

You're welcome. Is the list in your last post problems you still need fixed?

[jcsabi]

No, thanks, the macro "GetWorkbookByName" fixed it.