Search code examples
excelvbaipc

How to connect to OPEN workbook in another instance of Excel


Currently I can run 2 Excel VBA processes simultaneously within 2 separate Excel instances on 1 PC.

My goal is to import the data from Excel instance 2 into Excel instance 1 every minute.

Unfortunately it is not possible to connect from my workbook in Excel instance 1 to the open workbook in Excel instance 2.

Since I can connect to a saved workbook, a solution could be to save the workbook in instance 2 every minute and retrieve the new data from the saved workbook.

Although this is a rather heavy method. Is there a better solution to connect to another open workbook in another instance of Excel?

(To open the workbook in the same instance is no solution since in that case I can no longer run 2 VBA processes simultaneously.)


Solution

  • Short version


    Option Explicit
    
    Public Sub GetDataFromExternalXLInstance()
        Dim instanceFile As Object, ur As Variant, lr As Long
    
        'if not already open, GetObject() will open it in a new instance
    
        Set instanceFile = GetObject("C:\Tmp\TestData2.xlsx")  '(code running from TestData1)
        ur = instanceFile.Worksheets(2).UsedRange              'get used range from 2nd Worksheet
    
        With ActiveSheet
            lr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1    'last row on active sheet
            .Range(.Cells(lr, "A"), .Cells(UBound(ur) + lr - 1, UBound(ur, 2))) = ur
        End With
    
        'instanceFile.Close
        'Set instanceFile = Nothing
    End Sub
    

    Long version using API calls (from Excel Help file for GetObject())


    Option Explicit
    
    #If VBA7 Then   'or: #If Win64 Then  'Win64=true, Win32=true, Win16= false
        Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    #Else
        Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName as String, ByVal lpWindowName As Long) As Long
        Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd as Long,ByVal wMsg as Long, ByVal wParam as Long, ByVal lParam As Long) As Long
    #End If
    
    Public Sub GetDataFromExternalXLInstanceAPI()
        Dim xlApp As Object
        Dim xlNotRunning As Boolean 'Flag for final reference release
    
        On Error Resume Next        'Check if Excel is already running; defer error trapping
            Set xlApp = GetObject(, "Excel.Application")    'If it's not running an error occurs
            xlNotRunning = (Err.Number <> 0)
            Err.Clear               'Clear Err object in case of error
        On Error GoTo 0             'Reset error trapping
    
        DetectExcel                 'If Excel is running enter it into the Running Object table
        Set xlApp = GetObject("C:\Tmp\TestData2.xlsx")      'Set object reference to the file
    
        'Show Excel through its Application property
        xlApp.Application.Visible = True
        'Show the actual window of the file using the Windows collection of the xlApp object ref
        xlApp.Parent.Windows(1).Visible = True
    
        '... Process file
    
        'If Excel was not running when this started, close it using the App's Quit method
        If xlNotRunning = True Then xlApp.Application.Quit
        Set xlApp = Nothing    'Release reference to the application and spreadsheet
    End Sub
    

    Public Sub DetectExcel()    'This procedure detects a running Excel app and registers it
        Const WM_USER = 1024
        Dim hwnd As Long
    
        hwnd = FindWindow("XLMAIN", 0)  'If Excel is running this API call returns its handle
        If hwnd = 0 Then Exit Sub       '0 means Excel not running
    
        'Else Excel is running so use the SendMessage API function
        'to enter it in the Running Object Table
    
        SendMessage hwnd, WM_USER + 18, 0, 0
    End Sub