Question

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

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

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

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

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

（在同一个实例中打开工作簿是没有解决方案的，因为在这种情况下我不能再同时运行2个VBA进程。）

谢谢！

Answer 1

短版

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

Answer 2

不确定您对两个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

如何在另一个Excel实例

2 个答案: