TransWikia.com

How to add Open Workbook to "Application.Workbooks" collection and/or interact with Workbook

Stack Overflow Asked by FreeSoftwareServers on December 16, 2021

I have a macro which runs from wb=ThisWorkbook. It opens up Internet Explorer and retrieves another WB which automatically opens. I’m trying to copy the sheet from that WB to ThisWorkbook, but it doesn’t appear the "automatically opened" wb’s are included in "Application.Workbooks". Can I force an update to "Application.Workbooks" or hack around this limitation somehow?

More Details:

My macro opens IE, finds a button and presses it which automatically opens a separate instance of Excel/Workbook (not in protected mode). If i then go back to my main workbook and loop through all "Application.Workbooks" the recently opened workbook is not listed.

This is what I tried to list all WB’s and only the main WB that the macro runs from is listed.

Public Sub OpenWBs()
    Dim Workbooks As Workbook
    For Each Workbooks In Application.Workbooks
     MsgBox Workbooks.Name
    Next Workbooks
End Sub

enter image description here

4 Answers

Your above code can be used in the next way, being able to find an open session for unsaved files (without extension)

Public Sub Copy_External_WB()
 Dim xlApp As Excel.Application, xlBook As Worksheet, i As Long

 For i = 1 To 10
   On Error Resume Next
   Set xlApp = GetObject("Book" & i).Application
   If Err.Number = -2147221020 Then
        Err.Clear: On Error GoTo 0
   Else
        On Error GoTo 0
        Exit For
   End If
 Next i

 If Not xlApp Is Nothing Then
    Set xlBook = xlApp.Worksheets(1)
    Debug.Print xlApp.Hwnd, Application.Hwnd
 Else
    MsgBox "No Excel session with Book(1 - 10) open could be found..."
    xlApp.Quit: Exit Sub
 End If
 Dim CopyFrom As Range
 Set CopyFrom = xlBook.Range("A1:AQ56")

 Dim DS As Worksheet
 Set DS = ThisWorkbook.Worksheets("Merged")
 DS.Range("A1:AQ56").Resize(CopyFrom.Rows.count).Value = CopyFrom.Value

 xlApp.DisplayAlerts = False 'I think this is useless...
   xlApp.Quit
 xlApp.DisplayAlerts = True
 Set xlApp = Nothing
End Sub

Answered by FaneDuru on December 16, 2021

This worked for me perfectly.

Option Explicit
Public Sub Copy_External_WB()

Dim xlApp As Excel.Application, xlBook As Worksheet
Set xlApp = GetObject("Book3").Application
Set xlBook = xlApp.Worksheets(1)

Dim CopyFrom As Range
Set CopyFrom = xlBook.Range("A1:AQ56")

Dim DS As Worksheet
Set DS = ThisWorkbook.Worksheets("Merged")
DS.Range("A1:AQ56").Resize(CopyFrom.Rows.Count).Value = CopyFrom.Value

xlApp.DisplayAlerts = False
xlApp.Quit
xlApp.DisplayAlerts = True
Set xlApp = Nothing
End Sub

Answered by FreeSoftwareServers on December 16, 2021

Here's an example of how to list all workbooks open in all open instances of Excel.

The API calls are 32-bit so you'll need to adjust if you have 64-bit Excel.

Don't ask me to explain all of it - I cobbled it together from other posts.

Option Explicit

Private 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
Private Declare Function IIDFromString Lib "ole32" _
        (ByVal lpsz As Long, ByRef lpiid As GUID) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
        (ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As GUID, _
         ByRef ppvObject As Object) As Long
         
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Const S_OK As Long = &H0
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0

Sub Tester()

    Dim col As Collection, wb
    
    Set col = GetAllWorkbooks() '<< get all open workbooks
    For Each wb In col
        'Here's where you'd be looking for the one you want...
        Debug.Print wb.Name & ":" & _
           IIf(wb.Application.hWnd = Application.hWnd, _
               "In this instance", "In another instance")
    Next wb

End Sub




'return a collection of all open workbooks, regardless of Excel Instance
Function GetAllWorkbooks() As Collection
    Dim i As Long, s
    Dim hWinXL As Long
    Dim xlApp As Object 'Excel.Application
    Dim wb As Object  ' Excel.Workbook
    Dim dict, k, col As New Collection
    
    Set dict = CreateObject("scripting.dictionary")
    
    hWinXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
    While hWinXL > 0
        i = i + 1
        If GetXLapp(hWinXL, xlApp) Then
            If Not dict.exists(xlApp.hWnd) Then
                dict.Add xlApp.hWnd, xlApp
                s = s & "Instance: HWnd = " & xlApp.hWnd & vbLf
                For Each wb In xlApp.Workbooks
                    col.Add wb
                    s = s & "     " & wb.Name & vbLf
                Next
            End If
        End If
        hWinXL = FindWindowEx(0, hWinXL, "XLMAIN", vbNullString)
    Wend
    'Debug.Print s
    Set GetAllWorkbooks = col
End Function
'Function GetXLapp(hWinXL As Long, xlApp As Excel.Application) As Boolean
Function GetXLapp(hWinXL As Long, xlApp As Object) As Boolean
Dim hWinDesk As Long, hWin7 As Long
Dim obj As Object
Dim iid As GUID
    
    Call IIDFromString(StrPtr(IID_IDispatch), iid)
    hWinDesk = FindWindowEx(hWinXL, 0&, "XLDESK", vbNullString)
    hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)
    If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj) = S_OK Then
        Set xlApp = obj.Application
        GetXLapp = True
    End If
End Function

Answered by Tim Williams on December 16, 2021

List Open Workbooks

Using Tim Willams' code, you can do the following:

Option Explicit

' Copies the values from a specified range in a specified worksheet
' in the first workbook (unknown name) of a SECOND instance of Excel,
' to a specified worksheet in a workbook in the FIRST instance of Excel.
' Only if successful, asks to quit the second instance of Excel.
Sub copyWorkbook()
    
    ' Second Instance of Excel containing the Source Worksheet.
    Const srcID As Variant = 1
    Const srcRng As String = "A1:AQ56"
    
    ' First Instance of Excel containing the Target Worksheet.
    Const tgtID As Variant = "Merged"
    Const tgtFirst As String = "A1"
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Define Source Worksheet.
    Dim wbE As Workbook: getFirstWorkbook wbE: GoSub checkWorkbook
    Dim wsE As Worksheet: getWorksheet wsE, srcID, wbE
    GoSub checkWorksheet
    
    ' Write values from Source Range to Data Array.
    Dim Data As Variant: Data = wsE.Range(srcRng)
    ' Write values from Data Array to Target Range.
    wb.Worksheets(tgtID).Range(tgtFirst).Resize(UBound(Data), _
                                                UBound(Data, 2)).Value = Data
    
    ' Inform user.
    Dim Msg As Variant
    Msg = MsgBox("Data from workbook '" & wbE.Name & "' successfully " _
               & "transferred." & vbLf _
               & "Do you want to quit the 2nd instance of Excel.", _
               vbInformation + vbYesNo, "Success")
    If Msg = vbYes Then
        ' Quit second instance of Excel.
        quitExcelViaWorkbook wbE
    End If

Exit Sub

checkWorkbook:
    If wbE Is Nothing Then
        MsgBox "Only one instance of Excel is currently running.", _
               vbExclamation, "One Excel Only"
        Exit Sub
    End If
    Return
    
checkWorksheet:
    If wsE Is Nothing Then
        MsgBox "Worksheet '" & srcID & "' doesn't exist in workbook '" _
               & wbE.Name & "'.", vbExclamation, "No Worksheet"
        Exit Sub
    End If
    Return
    
End Sub

' If there are TWO instances of Excel currently running, assigns the first
' workbook (object) of the second instance to a declared workbook variable.
Sub getFirstWorkbook(ByRef WorkbookObject As Workbook)
    Dim coll As Collection: Set coll = GetAllWorkbooks()
    Dim wb As Workbook
    For Each wb In coll
        If wb.Application.hWnd <> Application.hWnd Then
            Set WorkbookObject = wb: Exit For
        End If
    Next wb
End Sub

' From a workbook (object), assigns a worksheet (object), using
' its name or index, to a declared worksheet variable.
Sub getWorksheet(ByRef WorksheetObject As Worksheet, _
                 WorksheetID As Variant, _
                 WorkbookObject As Workbook)
    On Error Resume Next
    Set WorksheetObject = WorkbookObject.Worksheets(WorksheetID)
End Sub

' If there are TWO instances of Excel currently running,
' quits the second instance of Excel.
Sub quitExcelViaWorkbook(WorkbookObject As Workbook)
    Dim xlApp As Application: Set xlApp = WorkbookObject.Application
    xlApp.DisplayAlerts = False: xlApp.Quit
End Sub

Some other trivial stuff:

' Writes the names and the hWnd of each open workbook in any instance of Excel,
' to the Immediate window. The order depends on which instance was last active.
Sub printWorkbooks()
    Dim coll As Collection: Set coll = GetAllWorkbooks()
    Dim wb As Workbook, i As Long
    For Each wb In coll
        i = i + 1
        Debug.Print i, wb.Application.hWnd, wb.Name
    Next wb
End Sub
' Counts the number of all instances of Excel.
Sub printNumberOfInstances()
    Dim coll As Collection: Set coll = GetAllWorkbooks()
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim wb As Workbook
    For Each wb In coll
        dict(wb.Application.hWnd) = Empty
    Next wb
    Debug.Print dict.Count
End Sub
' Counts the number of open workbooks in all instances of Excel.
Sub printNumberOfWorkbooks()
    Dim coll As Collection: Set coll = GetAllWorkbooks()
    Debug.Print coll.Count
End Sub

What the down vote and the first 4 comments are all about:

' Writes the names of all workbooks of the first instance of Excel only,
' to the Immediate window.
Sub listOpenWorkbooks()
    Dim wb As Workbook, wbName As String
    For Each wb In Workbooks
        wbName = wb.Name
        If wb.Name = ThisWorkbook.Name Then wbName = wbName & " (ThisWorkbook)"
        Debug.Print wbName
    Next wb
End Sub

Answered by VBasic2008 on December 16, 2021

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP