
どうもマサヤです!
今回は以外と難しい別プロセス(別インスタンス)の任意のExcelを全削除する方法を紹介します。
同じプロセスであれば、Closeで簡単に終了させることができますが、別プロセス(別インスタンス)となれば話がややこしくなります。
私も、かなり悩みましたので備忘録としつつ、再利用時にコピペで簡単に使えるように関数化しました。
もし、あなたが同じ悩みをお持ちなら使ってみてくださいね。
なぜ、別プロセスのExcelを終了できないのか?
VBAは同じプロセスのブック一覧を取得することは可能です。
ただ、別プロセスの全てのブックを参照して終了させることはVBAだけでは出来ないんです。
ではどうするのか?
ずばり、APIを使うことで解消します。
APIと聞くとややこしそうですが、難しくとらえずに便利なものであると認識して使ってみると、VBA単体では不可能なことが実現できたりします。
と、前置きはこの辺にして次からは実際のコードを紹介しますね!
別プロセス(別インスタンス)の任意のExcelを全て終了させるコード
APIを使ってますので、凄く長いコードになってます。
下記サイトを参考にさせていただきました。素晴らしいコードです。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=63055;id=excel
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) <> 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のコードを少し変えれば、自分以外の全てブックを閉じることもで可能ですよ。
別プロセスのブックを閉じたいときに、よければ活用してくださいね!
コメント