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
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
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
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP