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.