如何在另一个Excel实例中连接到OPEN工作簿

目前,我可以在1台PC上的2个独立的Excel实例内同时运行2个Excel VBA进程。

我的目标是每分钟将Excel实例2中的数据导入到Excel实例1中。

不幸的是,无法从Excel实例1中的工作簿连接到Excel实例2中的打开工作簿。

由于我可以连接到已保存的工作簿,因此解决scheme可能是每隔一分钟在实例2中保存工作簿,并从已保存的工作簿中检索新数据。

虽然这是一个相当沉重的方法。 有没有更好的解决scheme来连接到Excel的另一个实例中的另一个打开的工作簿?

(在同一个实例中打开工作簿是没有办法的,因为在这种情况下,我不能再同时运行2个VBA进程。)

谢谢!

简洁版本


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 

使用API​​调用的长版本(来自GetObject() Excel帮助文件)


 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 

不确定你的意思与两个Excel VBA进程同时进行,但如果您有一个工作簿在Excel的第二个实例中打开,您可以访问GetObject

 Sub ConnectToWB() Const FILENAME = "Fulle File Name" Dim wb As Workbook Dim wks As Worksheet Set wb = GetObject(FILENAME) Set wks = wb.Worksheets(1) Debug.Print wks.Cells(1, 1) End Sub