VBA 【コピペで使える！】別プロセスの特定Excelを一括終了する方法

どうもマサヤです！

今回は以外と難しい別プロセス（別インスタンス）の任意のExcelを全削除する方法を紹介します。

同じプロセスであれば、Closeで簡単に終了させることができますが、別プロセス（別インスタンス）となれば話がややこしくなります。

私も、かなり悩みましたので備忘録としつつ、再利用時にコピペで簡単に使えるように関数化しました。

もし、あなたが同じ悩みをお持ちなら使ってみてくださいね。

なぜ、別プロセスのExcelを終了できないのか？

VBAは同じプロセスのブック一覧を取得することは可能です。

ただ、別プロセスの全てのブックを参照して終了させることはVBAだけでは出来ないんです。

ではどうするのか？

ずばり、APIを使うことで解消します。

APIと聞くとややこしそうですが、難しくとらえずに便利なものであると認識して使ってみると、VBA単体では不可能なことが実現できたりします。

と、前置きはこの辺にして次からは実際のコードを紹介しますね！

別プロセス（別インスタンス）の任意のExcelを全て終了させるコード

APIを使ってますので、凄く長いコードになってます。

Option Explicit
Private Declare Function EnumWindows Lib "user32.dll" _
                        (ByVal lpEnumFunc As Long, _
                         ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32.dll" _
                        Alias "GetClassNameA" _
                        (ByVal hWnd As Long, _
                         ByVal lpClassName As String, _
                         ByVal nMaxCount As Long) As Long
Private Declare Function EnumChildWindows Lib "user32.dll" _
                        (ByVal hWndParent As Long, _
                         ByVal lpEnumFunc As Long, _
                         ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32.dll" _
                        Alias "GetWindowTextA" _
                        (ByVal hWnd As Long, _
                         ByVal lpString As String, _
                         ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" _
                        Alias "SendMessageA" _
                        (ByVal hWnd As Long, ByVal Msg As Long, _
                         ByVal wParam As Long, lParam As Any) As Long
Private Declare Function IIDFromString Lib "ole32" _
                        (lpsz As Any, lpiid As Any) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" _
                        (ByVal lResult As Long, riid As Any, _
                         ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function IsWindow Lib "user32" _
                        (ByVal hWnd As Long) As Long
                        
Private Const OBJID_NATIVEOM = &HFFFFFFF0
Private Const OBJID_CLIENT = &HFFFFFFFC

Private Const IID_IMdcList = "{8BD21D23-EC42-11CE-9E0D-00AA006002F3}"
Private Const IID_IUnknown = "{00000000-0000-0000-C000-000000000046}"
Private Const IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"

Private Const WM_GETOBJECT = &H3D&

Type WbkDtl
    hWnd        As Long
    wkb         As Excel.Workbook   ' 此処にブックのオブジェクトが入る
End Type
Private wD()     As WbkDtl
   
' コールバック関数
Public Function EnumWindowsProc(ByVal hWnd As Long, _
                         ByVal lParam As Long) As Long
  
    Dim strClassBuff    As String * 128
    Dim strClass        As String
    Dim lngRtnCode      As Long
    Dim lngThreadId     As Long
    Dim lngProcesID     As Long

    ' クラス名取得
    lngRtnCode = GetClassName(hWnd, strClassBuff, Len(strClassBuff))
    strClass = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
    If strClass = "XLMAIN" Then
        ' 子ウィンドウを列挙
        lngRtnCode = EnumChildWindows(hWnd, _
                            AddressOf EnumChildSubProc, lParam)
    End If
    ' 列挙を継続
EnumPass:
    EnumWindowsProc = True
End Function

' コールバック関数 - 子ウィンドウを列挙
Private Function EnumChildSubProc(ByVal hwndChild As Long, _
                                  ByVal lParam As Long) As Long
    Dim strClassBuff    As String * 128
    Dim strClass        As String
    Dim strTextBuff     As String * 516
    Dim strText         As String
    Dim lngRtnCode      As Long
  
    ' クラス名取得
    lngRtnCode = GetClassName(hwndChild, strClassBuff, Len(strClassBuff))
    strClass = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
    If strClass = "EXCEL7" Then
        ' テキストをバッファに
        lngRtnCode = GetWindowText(hwndChild, strTextBuff, Len(strTextBuff))
        strText = Left(strTextBuff, InStr(strTextBuff, vbNullChar) - 1)
  
        If InStr(1, strText, ".xla") = 0 Then     '
            If Sgn(wD) = 0 Then
                ReDim wD(0)
                wD(0).hWnd = hwndChild
            Else
                ReDim Preserve wD(UBound(wD) + 1)
                wD(UBound(wD)).hWnd = hwndChild
            End If
        End If
    End If
    ' 列挙を継続
EnumChildPass:
    EnumChildSubProc = True
End Function
Public Sub GetExcelBook(wDl As WbkDtl)
    Dim IID(0 To 3) As Long
    Dim bytID()     As Byte
    Dim lngResult   As Long
    Dim lngRtnCode As Long
    Dim wbw         As Excel.Window
  
    If IsWindow(wDl.hWnd) = 0 Then Exit Sub
    lngResult = SendMessage(wDl.hWnd, WM_GETOBJECT, 0, ByVal OBJID_NATIVEOM)
    If lngResult Then
        bytID = IID_IDispatch & vbNullChar
        IIDFromString bytID(0), IID(0)
        lngRtnCode = ObjectFromLresult(lngResult, IID(0), 0, wbw)
        If Not wbw Is Nothing Then Set wDl.wkb = wbw.Parent
    End If
End Sub

Sub Close_Other_Excel(targetBook)
    Dim lngRtnCode As Long
    Dim i           As Long
    Dim wbA         As Workbook
    Dim wbB         As Workbook
  
    Erase wD
'　 ワークブックのウィンドウハンドルを取得
    lngRtnCode = EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)
    If Sgn(wD) <> 0 Then
        For i = 0 To UBound(wD)
            Call GetExcelBook(wD(i))
            If InStr(wD(i).wkb.Name, targetBook) > 0 Then 'TargetBookに終了したいBook名を設定する。
                Application.DisplayAlerts = False  'POPUP（保存しますか？等）を無効に
                wD(i).wkb.Close 'ブックをクローズ
            End If
        Next
    End If
End Sub

長いコードですが、実際に使う際に意識するのは最後の関数であるClose_Other_Excelです。

コードの使い方

上記をコピペして、使う際は下記の様に使います。

Sub test()

Call Close_Other_Excel("Book")

End Sub

これで、ファイル名にBookが含まれている別プロセスのExcelを全て閉じることができます。

もちろん、Close_Other_Excelのコードを少し変えれば、自分以外の全てブックを閉じることもで可能ですよ。

別プロセスのブックを閉じたいときに、よければ活用してくださいね！