Excel VBAから他のExcelインスタンスを捕捉する。

Excel VBAから他のExcelインスタンスを捕捉する。

Option Explicit

Function GetOtherApplications()
Dim Path As String
Dim Applications As Variant
Dim Application2 As Object
Dim Count1 As Long
Dim Count2 As Long
Dim channelNumber As Long
Dim x As Variant

Applications = Array()
Count1 = GetObject("winmgmts:root\CIMV2").ExecQuery("SELECT * FROM Win32_Process WHERE Name='EXCEL.EXE'").Count
Do
  Application.DisplayAlerts = False
  channelNumber = Application.DDEInitiate("Excel", "System")
  Application.DisplayAlerts = True
  Application.DDEExecute channelNumber, "[NEW()]"
  x = Application.DDERequest(channelNumber, "Topics")
  Path = x(UBound(x) - 1)
  Path = Split(Mid(Path, 2), "]")(0)
  Set Application2 = GetObject(Path).Application
  Application.DDEExecute channelNumber, "[CLOSE()]"
  Application.DDETerminate channelNumber
  Count2 = GetObject("winmgmts:root\CIMV2").ExecQuery("SELECT * FROM Win32_Process WHERE Name='EXCEL.EXE'").Count
  If Count2 <> Count1 Then
    Application2.Quit
    Set Application2 = Nothing
    Exit Do
  End If
  ReDim Preserve Applications(UBound(Applications) + 1)
  Set Applications(UBound(Applications)) = Application2
  Application2.IgnoreRemoteRequests = True
Loop
For Count1 = 0 To UBound(Applications)
  Applications(Count1).IgnoreRemoteRequests = False
Next
GetOtherApplications = Applications
End Function

Sub sample()
MsgBox UBound(GetOtherApplications()) + 1
End Sub

配列 Applications() に実行中の他の Excel.Application オブジェクトへの参照が入ります。