Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to connect to OPEN workbook in another instance of Excel

Tags:

excel

vba

ipc

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.)

like image 234
user2165379 Avatar asked Oct 17 '22 06:10

user2165379


1 Answers

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
like image 172
paul bica Avatar answered Nov 15 '22 08:11

paul bica