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

この記事は約11分で読めます。
Excel 連結プルダウン

どうもマサヤです!

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

同じプロセスであれば、Closeで簡単に終了させることができます。

ただ、別プロセス(別インスタンス)となれば話がややこしくなります。

私も、かなり悩みましたので、備忘録として残します。

再利用する際、コピペで簡単に使えるように関数化してます。

もし、同じ悩みをお持ちなら、よければ使ってみてくださいね。

スポンサーリンク

なぜ、全ての別プロセスをCloseできないのか?

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

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

ではどうするのか?

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

APIと聞くとややこしそうですが、難しくとらえずに便利なものであると認識して

使ってみると、VBA単体では不可能なことが実現できたりします。

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

 

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

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

下記サイトを参考にさせていただきました。素晴らしいコードです。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=63055;id=excel
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) <&gt; 0 Then
        For i = 0 To UBound(wD)
            Call GetExcelBook(wD(i))
            If InStr(wD(i).wkb.Name, targetBook) &gt; 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のコードを少し変えれば、自分以外の全てブックを閉じることもで可能ですよ。

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

コメント