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 オブジェクトへの参照が入ります。
« 実行中の複数のExcelインスタンスをスクリプトから捕捉する。 | トップページ | そのExcelファイルが開かれているか?をスクリプトから調べる。 »